git.iko.soy/elk
on master help sign in
Make comparable work fully and clean up code
a1b7336Evan Czaplicki
compiler/Type/Unify.hs+32−15
compare with master
unifiedsplit
@@ -6,7 +6,6 @@ import qualified Data.Map as Map
6import qualified Type.State as TS
6import qualified Type.State as TS
7import Control.Arrow (first,second)
7import Control.Arrow (first,second)
8import Control.Monad.State
8import Control.Monad.State
9−import qualified Text.PrettyPrint as P
10
9
11unify :: Variable -> Variable -> StateT TS.SolverState IO ()
10unify :: Variable -> Variable -> StateT TS.SolverState IO ()
12unify variable1 variable2 = do
11unify variable1 variable2 = do
@@ -72,6 +71,32 @@ actuallyUnify variable1 variable2 = do
72 liftIO $ UF.modifyDescriptor var $ \desc -> desc { flex = Flexible }
71 liftIO $ UF.modifyDescriptor var $ \desc -> desc { flex = Flexible }
73 unify variable1 variable2
72 unify variable1 variable2
74
73
74+ unifyNumber svar name
75+ | name `elem` ["Int","Float"] = flexAndUnify svar
76+ | otherwise = TS.addError "Expecting a number (Int or Float)" variable1 variable2
77+
78+ comparableError str = TS.addError (str ++ msg) variable1 variable2
79+ where msg = "Expecting something comparable such as an\n" ++
80+ "Int, Float, Char, or a list or tuple of comparables."
81+
82+ unifyComparable var name
83+ | name `elem` ["Int","Float","Char"] = flexAndUnify var
84+ | otherwise = comparableError ""
85+
86+ unifyComparableStructure varSuper varFlex =
87+ do struct <- liftIO $ collectApps varFlex
88+ case struct of
89+ Other -> comparableError ""
90+ List v -> do flexAndUnify varSuper
91+ unify v =<< liftIO (var $ Is Comparable)
92+ Tuple vs
93+ | length vs > 6 ->
94+ comparableError "Cannot compare a tuple with more than 6 elements.\n"
95+ | otherwise ->
96+ do flexAndUnify varSuper
97+ cmpVars <- liftIO $ forM [1..length vs] $ \_ -> var (Is Comparable)
98+ zipWithM_ unify vs cmpVars
99+
75 superUnify =
100 superUnify =
76 case (flex desc1, flex desc2, name desc1, name desc2) of
101 case (flex desc1, flex desc2, name desc1, name desc2) of
77 (Is super1, Is super2, _, _)
102 (Is super1, Is super2, _, _)
@@ -79,21 +104,13 @@ actuallyUnify variable1 variable2 = do
79 (Is Number, Is Comparable, _, _) -> merge1
104 (Is Number, Is Comparable, _, _) -> merge1
80 (Is Comparable, Is Number, _, _) -> merge2
105 (Is Comparable, Is Number, _, _) -> merge2
81
106
82− (Is Number, _, _, Just name)
107+ (Is Number, _, _, Just name) -> unifyNumber variable1 name
83− | name `elem` ["Int","Float"] -> flexAndUnify variable1
84− | otherwise -> TS.addError "Expecting a number (Int or Float)" variable1 variable2
85−
86− (_, Is Number, Just name, _)
108+ (_, Is Number, Just name, _) -> unifyNumber variable2 name
87− | name `elem` ["Int","Float"] -> flexAndUnify variable2
88− | otherwise -> TS.addError "Expecting a number (Int or Float)" variable1 variable2
89−
90− (Is Comparable, _, _, Just name)
91− | name `elem` ["Int","Float","Char"] -> flexAndUnify variable1
92− | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
93
109
94− (_, Is Comparable, Just name, _)
110+ (Is Comparable, _, _, Just name) -> unifyComparable variable1 name
95− | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
111+ (_, Is Comparable, Just name, _) -> unifyComparable variable2 name
96− | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
112+ (Is Comparable, _, _, _) -> unifyComparableStructure variable1 variable2
113+ (_, Is Comparable, _, _) -> unifyComparableStructure variable2 variable1
97
114
98 _ -> TS.addError "" variable1 variable2
115 _ -> TS.addError "" variable1 variable2
99
116