git.iko.soy/elk
on master help sign in
Add support for "number" type which can be either an Int or Float
commit82ca695dcab510376d2a58c1842a6c157071fdd9 authorEvan Czaplicki <info@elm-lang.org> dateThu 25 Jul 2013, 01:24 (13 years ago) parent666d9f8
4 files changed+54−8
compare with master
unifiedsplit
compiler/Type/Environment.hs+18−3 compiler/Type/State.hs+3−1 compiler/Type/Type.hs+5−1 compiler/Type/Unify.hs+28−3
compiler/Type/Environment.hs+18−3
@@ -53,12 +53,21 @@ makeConstructors types = Map.fromList builtins
5353 where
5454 list t = (types ! "_List") <| t
5555 maybe t = (types ! "Maybe") <| t
56+ bool = types ! "Bool"
57+ int = types ! "Int"
58+ float = types ! "Float"
5659
5760 inst :: Int -> Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
5861 inst kind numTVars tipe = do
59− vars <- forM [1..numTVars] $ \_ -> flexibleVar
60− let (args, result) = tipe (map VarN vars)
61− return (kind, vars, args, result)
62+ vars <- forM [1..numTVars] $ \_ -> flexibleVar
63+ let (args, result) = tipe (map VarN vars)
64+ return (kind, vars, args, result)
65+
66+ nmbr :: Int -> (Type -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
67+ nmbr kind tipe = do
68+ var <- number
69+ let (args, result) = tipe (VarN var)
70+ return (kind, [var], args, result)
6271
6372 tupleCtor n =
6473 let name = "_Tuple" ++ show n
@@ -69,6 +78,12 @@ makeConstructors types = Map.fromList builtins
6978 , ("Just" , inst 1 1 $ \ [t] -> ([t], maybe t))
7079 , ("[]" , inst 0 1 $ \ [t] -> ([], list t))
7180 , ("::" , inst 2 1 $ \ [t] -> ([t, list t], list t))
81+ , ("div" , inst 2 0 $ \ [] -> ([int, int], int))
82+ , ("/" , inst 2 0 $ \ [] -> ([float, float], float))
83+ , ("+" , nmbr 2 $ \t -> ([t, t], t))
84+ , ("-" , nmbr 2 $ \t -> ([t, t], t))
85+ , ("*" , nmbr 2 $ \t -> ([t, t], t))
86+ , ("otherwise", inst 0 0 $ \ [] -> ([], bool))
7287 ] ++ map tupleCtor [0..9]
7388
7489
compiler/Type/State.hs+3−1
@@ -138,7 +138,9 @@ makeCopy alreadyCopied variable = do
138138 structure = Nothing,
139139 rank = maxRank pool,
140140 mark = noMark,
141− flex = Flexible,
141+ flex = case flex desc of
142+ IsIn s -> IsIn s
143+ _ -> Flexible,
142144 copy = Nothing,
143145 name = case flex desc of
144146 Rigid -> Nothing
compiler/Type/Type.hs+5−1
@@ -69,7 +69,10 @@ outermostRank = 0 :: Int
6969noMark = 0
7070initialMark = 1
7171
72−data Flex = Rigid | Flexible | Constant
72+data Flex = Rigid | Flexible | Constant | IsIn SuperType
73+ deriving (Show, Eq)
74+
75+data SuperType = Number | Comparable | Appendable
7376 deriving (Show, Eq)
7477
7578infixl 8 /\
@@ -91,6 +94,7 @@ a ==> b = TermN (Fun1 a b)
9194
9295f <| a = TermN (App1 f a)
9396
97+number = namedVar (IsIn Number) "number"
9498
9599namedVar flex name = UF.fresh $ Descriptor {
96100 structure = Nothing,
compiler/Type/Unify.hs+28−3
@@ -70,6 +70,30 @@ actuallyUnify variable1 variable2 = do
7070 }
7171 TS.register var
7272
73+ flexAndUnify var = do
74+ liftIO $ UF.modifyDescriptor var $ \desc -> desc { flex = Flexible }
75+ unify variable1 variable2
76+
77+ superUnify =
78+ case (flex desc1, flex desc2, name desc1, name desc2) of
79+ (IsIn Number, IsIn Number, _, _) -> merge
80+ (IsIn Number, IsIn Comparable, _, _) -> merge1
81+ (IsIn Comparable, IsIn Number, _, _) -> merge2
82+
83+ (IsIn Number, _, _, Just name)
84+ | name == "Int" || name == "Float" -> flexAndUnify variable1
85+
86+ (_, IsIn Number, Just name, _)
87+ | name == "Int" || name == "Float" -> flexAndUnify variable2
88+
89+ (IsIn Comparable, _, _, Just name)
90+ | name == "Int" || name == "Float" -> flexAndUnify variable1
91+
92+ (_, IsIn Comparable, Just name, _)
93+ | name == "Int" || name == "Float" -> flexAndUnify variable2
94+
95+ _ -> TS.addError "The following types are not equal" variable1 variable2
96+
7397 case (structure desc1, structure desc2) of
7498 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge
7599 (Nothing, _) | flex desc1 == Flexible -> merge2
@@ -78,8 +102,8 @@ actuallyUnify variable1 variable2 = do
78102 (Just (Var1 v), _) -> unify v variable2
79103 (_, Just (Var1 v)) -> unify v variable1
80104
81− (Nothing, _) -> TS.addError "The following types are not equal" variable1 variable2
82− (_, Nothing) -> TS.addError "The following types are not equal" variable1 variable2
105+ (Nothing, _) -> superUnify
106+ (_, Nothing) -> superUnify
83107
84108 (Just type1, Just type2) ->
85109 case (type1,type2) of
@@ -98,4 +122,5 @@ actuallyUnify variable1 variable2 = do
98122 (Record1 fields1 ext1, Record1 fields2 ext2) ->
99123 TS.addError "did not write record unification yet" variable1 variable2
100124
101− _ -> TS.addError "could not unify types" variable1 variable2
125+ _ -> TS.addError "could not unify types" variable1 variable2
126+