yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Stop using the MultiWayIf extension

Browse source
This commit is contained in:
Evan Czaplicki 2013-07-30 22:57:13 -07:00
parent 8006d8e54a
commit 3ef5284afd
2 changed files with 56 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
compiler/Type/Solve.hs
View file

@ -1,4 +1,3 @@
{-# LANGUAGE MultiWayIf #-}
module Type.Solve (solve) where
import Control.Monad
@ -68,23 +67,25 @@ adjustRank :: Int -> Int -> Int -> Variable -> StateT TS.SolverState IO Int
adjustRank youngMark visitedMark groupRank variable =
let adjust = adjustRank youngMark visitedMark groupRank in
do desc <- liftIO $ UF.descriptor variable
if | mark desc == youngMark -> do
rank' <- case structure desc of
case () of
() | mark desc == youngMark ->
do rank' <- case structure desc of
Nothing -> return groupRank
Just term -> case term of
Just term ->
case term of
App1 a b -> max `liftM` adjust a `ap` adjust b
Fun1 a b -> max `liftM` adjust a `ap` adjust b
Var1 x -> adjust x
EmptyRecord1 -> return outermostRank
Record1 fields extension -> do
ranks <- mapM adjust (concat (Map.elems fields))
Record1 fields extension ->
do ranks <- mapM adjust (concat (Map.elems fields))
rnk <- adjust extension
return . maximum $ rnk : ranks
liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })
return rank'
| mark desc /= visitedMark -> do
let rank' = min groupRank (rank desc)
| mark desc /= visitedMark ->
do let rank' = min groupRank (rank desc)
liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })
return rank'

5
compiler/Type/State.hs
View file

@ -1,4 +1,3 @@
{-# LANGUAGE MultiWayIf #-}
module Type.State where
import Type.Type
@ -128,7 +127,8 @@ makeInstance var = do
makeCopy :: Int -> Variable -> StateT SolverState IO Variable
makeCopy alreadyCopied variable = do
desc <- liftIO $ UF.descriptor variable
if | mark desc == alreadyCopied ->
case () of
() | mark desc == alreadyCopied ->
case copy desc of
Just v -> return v
Nothing -> error "This should be impossible."
@ -150,7 +150,6 @@ makeCopy alreadyCopied variable = do
Rigid -> Nothing
_ -> name desc
}
register newVar
-- Link the original variable to the new variable. This lets us