git.iko.soy/elk
on master help sign in
Properly unify constrained variables, serious changes here!!!
b6144aeEvan Czaplicki
compiler/Type/Unify.hs+30−29
compare with master
unifiedsplit
@@ -5,7 +5,6 @@ import qualified Data.UnionFind.IO as UF
5import qualified Type.State as TS
5import qualified Type.State as TS
6import Control.Arrow (first,second)
6import Control.Arrow (first,second)
7import Control.Monad.State
7import Control.Monad.State
8−import SourceSyntax.PrettyPrint
9import qualified Text.PrettyPrint as P
8import qualified Text.PrettyPrint as P
10
9
11unify :: Variable -> Variable -> StateT TS.SolverState IO ()
10unify :: Variable -> Variable -> StateT TS.SolverState IO ()
@@ -20,45 +19,43 @@ actuallyUnify variable1 variable2 = do
20 desc2 <- liftIO $ UF.descriptor variable2
19 desc2 <- liftIO $ UF.descriptor variable2
21 let name' :: Maybe String
20 let name' :: Maybe String
22 name' = case (name desc1, name desc2) of
21 name' = case (name desc1, name desc2) of
23− (Just name1, Just name2)
22+ (Just name1, Just name2) ->
24− | name1 == name2 -> Just name1
23+ case (flex desc1, flex desc2) of
25− | flex desc1 /= Flexible -> Just name1
24+ (_, Flexible) -> Just name1
26− | flex desc2 /= Flexible -> Just name2
25+ (Flexible, _) -> Just name2
26+ (IsIn Number, IsIn _) -> Just name1
27+ (IsIn _, IsIn Number) -> Just name2
28+ (IsIn _, IsIn _) -> Just name1
27− | otherwise -> Nothing
29+ (_, _) -> Nothing
28 (Just name1, _) -> Just name1
30 (Just name1, _) -> Just name1
29 (_, Just name2) -> Just name2
31 (_, Just name2) -> Just name2
30 _ -> Nothing
32 _ -> Nothing
31
33
32 flex' :: Flex
34 flex' :: Flex
33− flex' = if flex desc1 /= Flexible then flex desc1 else
35+ flex' = case (flex desc1, flex desc2) of
34− if flex desc2 /= Flexible then flex desc2 else Flexible
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
35
42
36 rank' :: Int
43 rank' :: Int
37 rank' = min (rank desc1) (rank desc2)
44 rank' = min (rank desc1) (rank desc2)
38
45
39 merge1 :: StateT TS.SolverState IO ()
46 merge1 :: StateT TS.SolverState IO ()
40− merge1 =
47+ merge1 = liftIO $ do
41− if rank desc1 < rank desc2 then
42− liftIO $ do
43− UF.union variable2 variable1
48+ if rank desc1 < rank desc2 then UF.union variable2 variable1
44− UF.modifyDescriptor variable1 (\desc -> desc { flex = flex', name = name' })
45− else
46− liftIO $ do
47− UF.union variable1 variable2
49+ else UF.union variable1 variable2
48− UF.modifyDescriptor variable2 (\desc -> desc {
50+ UF.modifyDescriptor variable1 $ \desc ->
49− structure = structure desc1, flex = flex', name = name' })
51+ desc { structure = structure desc1, flex = flex', name = name' }
50
52
51 merge2 :: StateT TS.SolverState IO ()
53 merge2 :: StateT TS.SolverState IO ()
52− merge2 =
54+ merge2 = liftIO $ do
53− if rank desc1 < rank desc2 then
54− liftIO $ do
55− UF.union variable2 variable1
55+ if rank desc1 < rank desc2 then 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
56+ else UF.union variable1 variable2
61− UF.modifyDescriptor variable2 (\desc -> desc { flex = flex', name = name' })
57+ UF.modifyDescriptor variable2 $ \desc ->
58+ desc { structure = structure desc2, flex = flex', name = name' }
62
59
63 merge = if rank desc1 < rank desc2 then merge1 else merge2
60 merge = if rank desc1 < rank desc2 then merge1 else merge2
64
61
@@ -79,18 +76,22 @@ actuallyUnify variable1 variable2 = do
79 (IsIn Number, IsIn Number, _, _) -> merge
76 (IsIn Number, IsIn Number, _, _) -> merge
80 (IsIn Number, IsIn Comparable, _, _) -> merge1
77 (IsIn Number, IsIn Comparable, _, _) -> merge1
81 (IsIn Comparable, IsIn Number, _, _) -> merge2
78 (IsIn Comparable, IsIn Number, _, _) -> merge2
82−
79+
83 (IsIn Number, _, _, Just name)
80 (IsIn Number, _, _, Just name)
84 | name `elem` ["Int","Float"] -> flexAndUnify variable1
81 | name `elem` ["Int","Float"] -> flexAndUnify variable1
82+ | otherwise -> TS.addError "Expecting a number (Int or Float)" variable1 variable2
85
83
86 (_, IsIn Number, Just name, _)
84 (_, IsIn Number, Just name, _)
87 | name `elem` ["Int","Float"] -> flexAndUnify variable2
85 | name `elem` ["Int","Float"] -> flexAndUnify variable2
86+ | otherwise -> TS.addError "Expecting a number (Int or Float)" variable1 variable2
88
87
89 (IsIn Comparable, _, _, Just name)
88 (IsIn Comparable, _, _, Just name)
90 | name `elem` ["Int","Float","Char"] -> flexAndUnify variable1
89 | name `elem` ["Int","Float","Char"] -> flexAndUnify variable1
90+ | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
91
91
92 (_, IsIn Comparable, Just name, _)
92 (_, IsIn Comparable, Just name, _)
93 | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
93 | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
94+ | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
94
95
95 _ -> TS.addError "The following types are not equal" variable1 variable2
96 _ -> TS.addError "The following types are not equal" variable1 variable2
96
97