From 3ef5284afd45bf4fca5e4d3a5b6a8cb569582ba9 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Tue, 30 Jul 2013 22:57:13 -0700 Subject: [PATCH] Stop using the MultiWayIf extension --- compiler/Type/Solve.hs | 41 ++++++++++++------------ compiler/Type/State.hs | 71 +++++++++++++++++++++--------------------- 2 files changed, 56 insertions(+), 56 deletions(-) diff --git a/compiler/Type/Solve.hs b/compiler/Type/Solve.hs index 6bdf46d..10ab4fb 100644 --- a/compiler/Type/Solve.hs +++ b/compiler/Type/Solve.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE MultiWayIf #-} module Type.Solve (solve) where import Control.Monad @@ -68,27 +67,29 @@ 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 - Nothing -> return groupRank - 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)) - rnk <- adjust extension - return . maximum $ rnk : ranks - liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' }) - return rank' + case () of + () | mark desc == youngMark -> + do rank' <- case structure desc of + Nothing -> return groupRank + 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)) + 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) - liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' }) - return rank' + | mark desc /= visitedMark -> + do let rank' = min groupRank (rank desc) + liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' }) + return rank' - | otherwise -> return (rank desc) + | otherwise -> return (rank desc) diff --git a/compiler/Type/State.hs b/compiler/Type/State.hs index 1a28e53..edbcd17 100644 --- a/compiler/Type/State.hs +++ b/compiler/Type/State.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE MultiWayIf #-} module Type.State where import Type.Type @@ -128,49 +127,49 @@ 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." - | rank desc /= noRank || flex desc == Constant -> + | rank desc /= noRank || flex desc == Constant -> return variable - | otherwise -> do - pool <- getPool - newVar <- liftIO $ UF.fresh $ Descriptor { - structure = Nothing, - rank = maxRank pool, - mark = noMark, - flex = case flex desc of - Is s -> Is s - _ -> Flexible, - copy = Nothing, - name = case flex desc of - Rigid -> Nothing - _ -> name desc - } + | otherwise -> do + pool <- getPool + newVar <- liftIO $ UF.fresh $ Descriptor { + structure = Nothing, + rank = maxRank pool, + mark = noMark, + flex = case flex desc of + Is s -> Is s + _ -> Flexible, + copy = Nothing, + name = case flex desc of + Rigid -> Nothing + _ -> name desc + } + register newVar - register newVar + -- Link the original variable to the new variable. This lets us + -- avoid making multiple copies of the variable we are instantiating. + -- + -- Need to do this before recursively copying the structure of + -- the variable to avoid looping on cyclic terms. + liftIO $ UF.modifyDescriptor variable $ \desc -> + desc { mark = alreadyCopied, copy = Just newVar } - -- Link the original variable to the new variable. This lets us - -- avoid making multiple copies of the variable we are instantiating. - -- - -- Need to do this before recursively copying the structure of - -- the variable to avoid looping on cyclic terms. - liftIO $ UF.modifyDescriptor variable $ \desc -> - desc { mark = alreadyCopied, copy = Just newVar } - - -- Now we recursively copy the structure of the variable. - -- We have already marked the variable as copied, so we - -- will not repeat this work or crawl this variable again. - case structure desc of - Nothing -> return newVar - Just term -> do - newTerm <- traverseTerm (makeCopy alreadyCopied) term - liftIO $ UF.modifyDescriptor newVar $ \desc -> - desc { structure = Just newTerm } - return newVar + -- Now we recursively copy the structure of the variable. + -- We have already marked the variable as copied, so we + -- will not repeat this work or crawl this variable again. + case structure desc of + Nothing -> return newVar + Just term -> do + newTerm <- traverseTerm (makeCopy alreadyCopied) term + liftIO $ UF.modifyDescriptor newVar $ \desc -> + desc { structure = Just newTerm } + return newVar restore :: Int -> Variable -> StateT SolverState IO Variable restore alreadyCopied variable = do