git.iko.soy/elk
on master help sign in
Stop using the MultiWayIf extension
3ef5284Evan Czaplicki
compiler/Type/Solve.hs+23−22
compare with master
unifiedsplit
@@ -1,4 +1,3 @@
1−{-# LANGUAGE MultiWayIf #-}
2module Type.Solve (solve) where
1module Type.Solve (solve) where
3
2
4import Control.Monad
3import Control.Monad
@@ -68,27 +67,29 @@ adjustRank :: Int -> Int -> Int -> Variable -> StateT TS.SolverState IO Int
68adjustRank youngMark visitedMark groupRank variable =
67adjustRank youngMark visitedMark groupRank variable =
69 let adjust = adjustRank youngMark visitedMark groupRank in
68 let adjust = adjustRank youngMark visitedMark groupRank in
70 do desc <- liftIO $ UF.descriptor variable
69 do desc <- liftIO $ UF.descriptor variable
70+ case () of
71− if | mark desc == youngMark -> do
71+ () | mark desc == youngMark ->
72− rank' <- case structure desc of
72+ do rank' <- case structure desc of
73− Nothing -> return groupRank
73+ Nothing -> return groupRank
74+ Just term ->
74− Just term -> case term of
75+ case term of
75− App1 a b -> max `liftM` adjust a `ap` adjust b
76+ App1 a b -> max `liftM` adjust a `ap` adjust b
76− Fun1 a b -> max `liftM` adjust a `ap` adjust b
77+ Fun1 a b -> max `liftM` adjust a `ap` adjust b
77− Var1 x -> adjust x
78+ Var1 x -> adjust x
78− EmptyRecord1 -> return outermostRank
79+ EmptyRecord1 -> return outermostRank
79− Record1 fields extension -> do
80+ Record1 fields extension ->
80− ranks <- mapM adjust (concat (Map.elems fields))
81+ do ranks <- mapM adjust (concat (Map.elems fields))
81− rnk <- adjust extension
82+ rnk <- adjust extension
82− return . maximum $ rnk : ranks
83+ return . maximum $ rnk : ranks
83− liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })
84+ liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })
84− return rank'
85+ return rank'
85−
86+
86− | mark desc /= visitedMark -> do
87+ | mark desc /= visitedMark ->
87− let rank' = min groupRank (rank desc)
88+ do let rank' = min groupRank (rank desc)
88− liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })
89+ liftIO $ UF.setDescriptor variable (desc { mark = visitedMark, rank = rank' })
89− return rank'
90+ return rank'
90−
91+
91− | otherwise -> return (rank desc)
92+ | otherwise -> return (rank desc)
92
93
93
94
94
95
compiler/Type/State.hs+37−38
@@ -1,4 +1,3 @@
1−{-# LANGUAGE MultiWayIf #-}
2module Type.State where
1module Type.State where
3
2
4import Type.Type
3import Type.Type
@@ -128,49 +127,49 @@ makeInstance var = do
128makeCopy :: Int -> Variable -> StateT SolverState IO Variable
127makeCopy :: Int -> Variable -> StateT SolverState IO Variable
129makeCopy alreadyCopied variable = do
128makeCopy alreadyCopied variable = do
130 desc <- liftIO $ UF.descriptor variable
129 desc <- liftIO $ UF.descriptor variable
130+ case () of
131− if | mark desc == alreadyCopied ->
131+ () | mark desc == alreadyCopied ->
132 case copy desc of
132 case copy desc of
133 Just v -> return v
133 Just v -> return v
134 Nothing -> error "This should be impossible."
134 Nothing -> error "This should be impossible."
135
135
136− | rank desc /= noRank || flex desc == Constant ->
136+ | rank desc /= noRank || flex desc == Constant ->
137 return variable
137 return variable
138
138
139− | otherwise -> do
139+ | otherwise -> do
140− pool <- getPool
140+ pool <- getPool
141− newVar <- liftIO $ UF.fresh $ Descriptor {
141+ newVar <- liftIO $ UF.fresh $ Descriptor {
142− structure = Nothing,
142+ structure = Nothing,
143− rank = maxRank pool,
143+ rank = maxRank pool,
144− mark = noMark,
144+ mark = noMark,
145− flex = case flex desc of
145+ flex = case flex desc of
146− Is s -> Is s
146+ Is s -> Is s
147− _ -> Flexible,
147+ _ -> Flexible,
148− copy = Nothing,
148+ copy = Nothing,
149− name = case flex desc of
149+ name = case flex desc of
150− Rigid -> Nothing
150+ Rigid -> Nothing
151− _ -> name desc
151+ _ -> name desc
152− }
152+ }
153−
154− register newVar
153+ register newVar
155−
154+
156− -- Link the original variable to the new variable. This lets us
155+ -- Link the original variable to the new variable. This lets us
157− -- avoid making multiple copies of the variable we are instantiating.
156+ -- avoid making multiple copies of the variable we are instantiating.
158− --
157+ --
159− -- Need to do this before recursively copying the structure of
158+ -- Need to do this before recursively copying the structure of
160− -- the variable to avoid looping on cyclic terms.
159+ -- the variable to avoid looping on cyclic terms.
161− liftIO $ UF.modifyDescriptor variable $ \desc ->
160+ liftIO $ UF.modifyDescriptor variable $ \desc ->
162− desc { mark = alreadyCopied, copy = Just newVar }
161+ desc { mark = alreadyCopied, copy = Just newVar }
163−
162+
164− -- Now we recursively copy the structure of the variable.
163+ -- Now we recursively copy the structure of the variable.
165− -- We have already marked the variable as copied, so we
164+ -- We have already marked the variable as copied, so we
166− -- will not repeat this work or crawl this variable again.
165+ -- will not repeat this work or crawl this variable again.
167− case structure desc of
166+ case structure desc of
168− Nothing -> return newVar
167+ Nothing -> return newVar
169− Just term -> do
168+ Just term -> do
170− newTerm <- traverseTerm (makeCopy alreadyCopied) term
169+ newTerm <- traverseTerm (makeCopy alreadyCopied) term
171− liftIO $ UF.modifyDescriptor newVar $ \desc ->
170+ liftIO $ UF.modifyDescriptor newVar $ \desc ->
172− desc { structure = Just newTerm }
171+ desc { structure = Just newTerm }
173− return newVar
172+ return newVar
174
173
175restore :: Int -> Variable -> StateT SolverState IO Variable
174restore :: Int -> Variable -> StateT SolverState IO Variable
176restore alreadyCopied variable = do
175restore alreadyCopied variable = do