@@ -5,7 +5,6 @@ import qualified Data.UnionFind.IO as UF
55import qualified Type.State as TS
66import Control.Arrow (first,second)
77import Control.Monad.State
8−import SourceSyntax.PrettyPrint
98import qualified Text.PrettyPrint as P
109
1110unify :: Variable -> Variable -> StateT TS.SolverState IO ()
@@ -20,45 +19,43 @@ actuallyUnify variable1 variable2 = do
2019 desc2 <- liftIO $ UF.descriptor variable2
2120 let name' :: Maybe String
2221 name' = case (name desc1, name desc2) of
23− (Just name1, Just name2)
24− | name1 == name2 -> Just name1
25− | flex desc1 /= Flexible -> Just name1
26− | flex desc2 /= Flexible -> Just name2
27− | otherwise -> Nothing
22+ (Just name1, Just name2) ->
23+ case (flex desc1, flex desc2) of
24+ (_, Flexible) -> Just name1
25+ (Flexible, _) -> Just name2
26+ (IsIn Number, IsIn _) -> Just name1
27+ (IsIn _, IsIn Number) -> Just name2
28+ (IsIn _, IsIn _) -> Just name1
29+ (_, _) -> Nothing
2830 (Just name1, _) -> Just name1
2931 (_, Just name2) -> Just name2
3032 _ -> Nothing
3133
3234 flex' :: Flex
33− flex' = if flex desc1 /= Flexible then flex desc1 else
34− if flex desc2 /= Flexible then flex desc2 else Flexible
35+ flex' = case (flex desc1, flex desc2) of
36+ (f, Flexible) -> f
37+ (Flexible, f) -> f
38+ (IsIn Number, IsIn _) -> IsIn Number
39+ (IsIn _, IsIn Number) -> IsIn Number
40+ (IsIn super, IsIn _) -> IsIn super
41+ (_, _) -> Flexible
3542
3643 rank' :: Int
3744 rank' = min (rank desc1) (rank desc2)
3845
3946 merge1 :: StateT TS.SolverState IO ()
40− merge1 =
41− if rank desc1 < rank desc2 then
42− liftIO $ do
43− UF.union variable2 variable1
44− UF.modifyDescriptor variable1 (\desc -> desc { flex = flex', name = name' })
45− else
46− liftIO $ do
47− UF.union variable1 variable2
48− UF.modifyDescriptor variable2 (\desc -> desc {
49− structure = structure desc1, flex = flex', name = name' })
47+ merge1 = liftIO $ do
48+ if rank desc1 < rank desc2 then UF.union variable2 variable1
49+ else UF.union variable1 variable2
50+ UF.modifyDescriptor variable1 $ \desc ->
51+ desc { structure = structure desc1, flex = flex', name = name' }
5052
5153 merge2 :: StateT TS.SolverState IO ()
52− merge2 =
53− if rank desc1 < rank desc2 then
54− liftIO $ do
55− UF.union variable2 variable1
56− UF.modifyDescriptor variable2 (\desc -> desc {
57− structure = structure desc2, flex = flex', name = name' })
58− else
59− liftIO $ do
60− UF.union variable1 variable2
61− UF.modifyDescriptor variable2 (\desc -> desc { flex = flex', name = name' })
54+ merge2 = liftIO $ do
55+ if rank desc1 < rank desc2 then UF.union variable2 variable1
56+ else UF.union variable1 variable2
57+ UF.modifyDescriptor variable2 $ \desc ->
58+ desc { structure = structure desc2, flex = flex', name = name' }
6259
6360 merge = if rank desc1 < rank desc2 then merge1 else merge2
6461
@@ -79,18 +76,22 @@ actuallyUnify variable1 variable2 = do
7976 (IsIn Number, IsIn Number, _, _) -> merge
8077 (IsIn Number, IsIn Comparable, _, _) -> merge1
8178 (IsIn Comparable, IsIn Number, _, _) -> merge2
82−
79+
8380 (IsIn Number, _, _, Just name)
8481 | name `elem` ["Int","Float"] -> flexAndUnify variable1
82+ | otherwise -> TS.addError "Expecting a number (Int or Float)" variable1 variable2
8583
8684 (_, IsIn Number, Just name, _)
8785 | name `elem` ["Int","Float"] -> flexAndUnify variable2
86+ | otherwise -> TS.addError "Expecting a number (Int or Float)" variable1 variable2
8887
8988 (IsIn Comparable, _, _, Just name)
9089 | name `elem` ["Int","Float","Char"] -> flexAndUnify variable1
90+ | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
9191
9292 (_, IsIn Comparable, Just name, _)
9393 | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
94+ | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
9495
9596 _ -> TS.addError "The following types are not equal" variable1 variable2
9697