@@ -71,7 +71,10 @@ actuallyUnify :: Variable -> Variable -> Unify ()
71actuallyUnify variable1 variable2 = do
71actuallyUnify variable1 variable2 = do
72 desc1 <- liftIO $ UF.descriptor variable1
72 desc1 <- liftIO $ UF.descriptor variable1
73 desc2 <- liftIO $ UF.descriptor variable2
73 desc2 <- liftIO $ UF.descriptor variable2
74+ let name' = pickName desc1 desc2
75+ flex' = pickFlex desc1 desc2
76+ rank' = pickRank desc1 desc2
74− let (name', flex', rank', alias') = combinedDescriptors desc1 desc2
77+ alias' = pickAlias desc1 desc2
76 merge1 :: Unify ()
79 merge1 :: Unify ()
@@ -170,7 +173,7 @@ actuallyUnify variable1 variable2 = do
170 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)
173 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> variable (Is Comparable)
171 zipWithM_ unifyHelp vs cmpVars
174 zipWithM_ unifyHelp vs cmpVars
173− unifyAppendable v cvar@(Var.Canonical home name) =
176+ unifyAppendable v cvar =
175 canUnify =
178 canUnify =
176 Var.isPrim "String" cvar
179 Var.isPrim "String" cvar
@@ -389,50 +392,57 @@ gatherFields var =
389fieldMismatchError :: Map.Map String a -> String
392fieldMismatchError :: Map.Map String a -> String
390fieldMismatchError missingFields =
393fieldMismatchError missingFields =
391 case Map.keys missingFields of
394 case Map.keys missingFields of
394− "Looks like a record is missing the field `" ++ key ++ "`"
399+ "Looks like a record is missing the field `" ++ key ++ "`"
396− "Looks like a record is missing fields "
402+ "Looks like a record is missing fields "
397− ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys
403+ ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys
400−combinedDescriptors
406+
401− :: Descriptor
407+pickAlias :: Descriptor -> Descriptor -> Alias Variable
403− -> (Maybe Var.Canonical, Flex, Int, Alias Variable)
404−combinedDescriptors desc1 desc2 =
408+pickAlias desc1 desc2 =
405− (name', flex', rank', alias')
409+ alias desc1 <|> alias desc2
408− rank' =
412+pickRank :: Descriptor -> Descriptor -> Int
413+pickRank desc1 desc2 =
409− min (rank desc1) (rank desc2)
414+ min (rank desc1) (rank desc2)
411− alias' :: Alias Variable
416+
412− alias' =
417+pickFlex :: Descriptor -> Descriptor -> Flex
413− alias desc1 <|> alias desc2
415− name' :: Maybe Var.Canonical
417− case (name desc1, name desc2) of
418+pickFlex desc1 desc2 =
418− (Just name1, Just name2) ->
419− case (flex desc1, flex desc2) of
419+ case (flex desc1, flex desc2) of
420− (_, Flexible) -> Just name1
420+ ( f , Flexible ) -> f
421− (Flexible, _) -> Just name2
421+ ( Flexible , f ) -> f
422− (Is Number, Is _) -> Just name1
422+ ( Is Number , Is _ ) -> Is Number
423− (Is _, Is Number) -> Just name2
423+ ( Is _ , Is Number ) -> Is Number
424− (Is _, Is _) -> Just name1
424+ ( Is super , Is _ ) -> Is super
425+ ( _ , _ ) -> Flexible
428+pickName :: Descriptor -> Descriptor -> Maybe Var.Canonical
429+pickName desc1 desc2 =
430+ case (name desc1, name desc2) of
425− (_, _) -> Nothing
431+ (Nothing, Nothing) ->
434+ (Just name1, Nothing) ->
426− (Just name1, _) -> Just name1
435+ Just name1
437+ (Nothing, Just name2) ->
427− (_, Just name2) -> Just name2
438+ Just name2
429−
440+ (Just name1, Just name2) ->
432− case (flex desc1, flex desc2) of
441+ case (flex desc1, flex desc2) of
433− (f, Flexible) -> f
442+ ( _ , Flexible ) -> Just name1
434− (Flexible, f) -> f
443+ ( Flexible , _ ) -> Just name2
435− (Is Number, Is _) -> Is Number
444+ ( Is Number , Is _ ) -> Just name1
436− (Is _, Is Number) -> Is Number
445+ ( Is _ , Is Number ) -> Just name2
437− (Is super, Is _) -> Is super
446+ ( Is _ , Is _ ) -> Just name1
438− (_, _) -> Flexible
447+ ( _ , _ ) -> Nothing