on master help sign in
cosmetic: make actuallyUnify less monolithic
commit0dc89bfc625d2fc54e1b2d6cd7628f802f3bdd67 authorEvan Czaplicki <info@elm-lang.org> dateSat 7 Jun 2014, 12:34 (12 years ago) parenta12554f
1 file changed+35−28
compiler/Type/Unify.hs+35−28
compiler/Type/Unify.hs+35−28
@@ -26,34 +26,7 @@ actuallyUnify region variable1 variable2 = do
2626 desc2 <- liftIO $ UF.descriptor variable2
2727 let unify' = unify region
2828
29− name' :: Maybe Var.Canonical
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
29+ (name', flex', rank', alias') = combinedDescriptors desc1 desc2
5730
5831 merge1 :: StateT TS.SolverState IO ()
5932 merge1 = liftIO $ do
@@ -170,6 +143,7 @@ actuallyUnify region variable1 variable2 = do
170143 (_, Rigid, _, _) -> rigidError variable2
171144 _ -> TS.addError region Nothing variable1 variable2
172145
146+ liftIO (print (alias desc1, alias desc2, alias'))
173147 case (structure desc1, structure desc2) of
174148 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge
175149 (Nothing, _) | flex desc1 == Flexible -> merge2
@@ -225,3 +199,36 @@ actuallyUnify region variable1 variable2 = do
225199
226200 _ -> TS.addError region Nothing variable1 variable2
227201
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