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