git.iko.soy/elk
on master help sign in
cosmetic: make actuallyUnify less monolithic
0dc89bfEvan Czaplicki
compiler/Type/Unify.hs+35−28
compare with master
unifiedsplit
@@ -26,34 +26,7 @@ actuallyUnify region variable1 variable2 = do
26 desc2 <- liftIO $ UF.descriptor variable2
26 desc2 <- liftIO $ UF.descriptor variable2
27 let unify' = unify region
27 let unify' = unify region
28
28
29− name' :: Maybe Var.Canonical
29+ (name', flex', rank', alias') = combinedDescriptors desc1 desc2
30− name' = case (name desc1, name desc2) of
31− (Just name1, Just name2) ->
32− case (flex desc1, flex desc2) of
33− (_, Flexible) -> Just name1
34− (Flexible, _) -> Just name2
35− (Is Number, Is _) -> Just name1
36− (Is _, Is Number) -> Just name2
37− (Is _, Is _) -> Just name1
38− (_, _) -> Nothing
39− (Just name1, _) -> Just name1
40− (_, Just name2) -> Just name2
41− _ -> Nothing
42−
43− flex' :: Flex
44− flex' = case (flex desc1, flex desc2) of
45− (f, Flexible) -> f
46− (Flexible, f) -> f
47− (Is Number, Is _) -> Is Number
48− (Is _, Is Number) -> Is Number
49− (Is super, Is _) -> Is super
50− (_, _) -> Flexible
51−
52− rank' :: Int
53− rank' = min (rank desc1) (rank desc2)
54−
55− alias' :: Maybe Var.Canonical
56− alias' = alias desc1 <|> alias desc2
57
30
58 merge1 :: StateT TS.SolverState IO ()
31 merge1 :: StateT TS.SolverState IO ()
59 merge1 = liftIO $ do
32 merge1 = liftIO $ do
@@ -170,6 +143,7 @@ actuallyUnify region variable1 variable2 = do
170 (_, Rigid, _, _) -> rigidError variable2
143 (_, Rigid, _, _) -> rigidError variable2
171 _ -> TS.addError region Nothing variable1 variable2
144 _ -> TS.addError region Nothing variable1 variable2
172
145
146+ liftIO (print (alias desc1, alias desc2, alias'))
173 case (structure desc1, structure desc2) of
147 case (structure desc1, structure desc2) of
174 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge
148 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge
175 (Nothing, _) | flex desc1 == Flexible -> merge2
149 (Nothing, _) | flex desc1 == Flexible -> merge2
@@ -225,3 +199,36 @@ actuallyUnify region variable1 variable2 = do
225
199
226 _ -> TS.addError region Nothing variable1 variable2
200 _ -> TS.addError region Nothing variable1 variable2
227
201
202+combinedDescriptors :: Descriptor -> Descriptor
203+ -> (Maybe Var.Canonical, Flex, Int, Maybe Var.Canonical)
204+combinedDescriptors desc1 desc2 =
205+ (name', flex', rank', alias')
206+ where
207+ rank' :: Int
208+ rank' = min (rank desc1) (rank desc2)
209+
210+ alias' :: Maybe Var.Canonical
211+ alias' = alias desc1 <|> alias desc2
212+
213+ name' :: Maybe Var.Canonical
214+ name' = case (name desc1, name desc2) of
215+ (Just name1, Just name2) ->
216+ case (flex desc1, flex desc2) of
217+ (_, Flexible) -> Just name1
218+ (Flexible, _) -> Just name2
219+ (Is Number, Is _) -> Just name1
220+ (Is _, Is Number) -> Just name2
221+ (Is _, Is _) -> Just name1
222+ (_, _) -> Nothing
223+ (Just name1, _) -> Just name1
224+ (_, Just name2) -> Just name2
225+ _ -> Nothing
226+
227+ flex' :: Flex
228+ flex' = case (flex desc1, flex desc2) of
229+ (f, Flexible) -> f
230+ (Flexible, f) -> f
231+ (Is Number, Is _) -> Is Number
232+ (Is _, Is Number) -> Is Number
233+ (Is super, Is _) -> Is super
234+ (_, _) -> Flexible