@@ -6,7 +6,6 @@ import qualified Data.Map as Map
66import qualified Type.State as TS
77import Control.Arrow (first,second)
88import Control.Monad.State
9−import qualified Text.PrettyPrint as P
109
1110unify :: Variable -> Variable -> StateT TS.SolverState IO ()
1211unify variable1 variable2 = do
@@ -72,6 +71,32 @@ actuallyUnify variable1 variable2 = do
7271 liftIO $ UF.modifyDescriptor var $ \desc -> desc { flex = Flexible }
7372 unify variable1 variable2
7473
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+
75100 superUnify =
76101 case (flex desc1, flex desc2, name desc1, name desc2) of
77102 (Is super1, Is super2, _, _)
@@ -79,21 +104,13 @@ actuallyUnify variable1 variable2 = do
79104 (Is Number, Is Comparable, _, _) -> merge1
80105 (Is Comparable, Is Number, _, _) -> merge2
81106
82− (Is Number, _, _, Just 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, _)
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
107+ (Is Number, _, _, Just name) -> unifyNumber variable1 name
108+ (_, Is Number, Just name, _) -> unifyNumber variable2 name
93109
94− (_, Is Comparable, Just name, _)
95− | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
96− | otherwise -> TS.addError "Expecting something comparable (Int, Float, Char, [comparable])." variable1 variable2
110+ (Is Comparable, _, _, Just name) -> unifyComparable variable1 name
111+ (_, Is Comparable, Just name, _) -> unifyComparable variable2 name
112+ (Is Comparable, _, _, _) -> unifyComparableStructure variable1 variable2
113+ (_, Is Comparable, _, _) -> unifyComparableStructure variable2 variable1
97114
98115 _ -> TS.addError "" variable1 variable2
99116