git.iko.soy/elk
on master help sign in
Add support for "number" type which can be either an Int or Float
82ca695Evan Czaplicki
compiler/Type/Environment.hs+18−3
compare with master
unifiedsplit
@@ -53,12 +53,21 @@ makeConstructors types = Map.fromList builtins
53 where
53 where
54 list t = (types ! "_List") <| t
54 list t = (types ! "_List") <| t
55 maybe t = (types ! "Maybe") <| t
55 maybe t = (types ! "Maybe") <| t
56+ bool = types ! "Bool"
57+ int = types ! "Int"
58+ float = types ! "Float"
56
59
57 inst :: Int -> Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
60 inst :: Int -> Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
58 inst kind numTVars tipe = do
61 inst kind numTVars tipe = do
59− vars <- forM [1..numTVars] $ \_ -> flexibleVar
62+ vars <- forM [1..numTVars] $ \_ -> flexibleVar
60− let (args, result) = tipe (map VarN vars)
63+ let (args, result) = tipe (map VarN vars)
61− return (kind, vars, args, result)
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)
62
71
63 tupleCtor n =
72 tupleCtor n =
64 let name = "_Tuple" ++ show n
73 let name = "_Tuple" ++ show n
@@ -69,6 +78,12 @@ makeConstructors types = Map.fromList builtins
69 , ("Just" , inst 1 1 $ \ [t] -> ([t], maybe t))
78 , ("Just" , inst 1 1 $ \ [t] -> ([t], maybe t))
70 , ("[]" , inst 0 1 $ \ [t] -> ([], list t))
79 , ("[]" , inst 0 1 $ \ [t] -> ([], list t))
71 , ("::" , inst 2 1 $ \ [t] -> ([t, list t], list t))
80 , ("::" , 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))
72 ] ++ map tupleCtor [0..9]
87 ] ++ map tupleCtor [0..9]
73
88
74
89
compiler/Type/State.hs+3−1
@@ -138,7 +138,9 @@ makeCopy alreadyCopied variable = do
138 structure = Nothing,
138 structure = Nothing,
139 rank = maxRank pool,
139 rank = maxRank pool,
140 mark = noMark,
140 mark = noMark,
141+ flex = case flex desc of
142+ IsIn s -> IsIn s
141− flex = Flexible,
143+ _ -> Flexible,
142 copy = Nothing,
144 copy = Nothing,
143 name = case flex desc of
145 name = case flex desc of
144 Rigid -> Nothing
146 Rigid -> Nothing
compiler/Type/Type.hs+5−1
@@ -69,7 +69,10 @@ outermostRank = 0 :: Int
69noMark = 0
69noMark = 0
70initialMark = 1
70initialMark = 1
71
71
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
73 deriving (Show, Eq)
76 deriving (Show, Eq)
74
77
75infixl 8 /\
78infixl 8 /\
@@ -91,6 +94,7 @@ a ==> b = TermN (Fun1 a b)
91
94
92f <| a = TermN (App1 f a)
95f <| a = TermN (App1 f a)
93
96
97+number = namedVar (IsIn Number) "number"
94
98
95namedVar flex name = UF.fresh $ Descriptor {
99namedVar flex name = UF.fresh $ Descriptor {
96 structure = Nothing,
100 structure = Nothing,
compiler/Type/Unify.hs+28−3
@@ -70,6 +70,30 @@ actuallyUnify variable1 variable2 = do
70 }
70 }
71 TS.register var
71 TS.register var
72
72
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+
73 case (structure desc1, structure desc2) of
97 case (structure desc1, structure desc2) of
74 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge
98 (Nothing, Nothing) | flex desc1 == Flexible && flex desc1 == Flexible -> merge
75 (Nothing, _) | flex desc1 == Flexible -> merge2
99 (Nothing, _) | flex desc1 == Flexible -> merge2
@@ -78,8 +102,8 @@ actuallyUnify variable1 variable2 = do
78 (Just (Var1 v), _) -> unify v variable2
102 (Just (Var1 v), _) -> unify v variable2
79 (_, Just (Var1 v)) -> unify v variable1
103 (_, Just (Var1 v)) -> unify v variable1
80
104
81− (Nothing, _) -> TS.addError "The following types are not equal" variable1 variable2
105+ (Nothing, _) -> superUnify
82− (_, Nothing) -> TS.addError "The following types are not equal" variable1 variable2
106+ (_, Nothing) -> superUnify
83
107
84 (Just type1, Just type2) ->
108 (Just type1, Just type2) ->
85 case (type1,type2) of
109 case (type1,type2) of
@@ -98,4 +122,5 @@ actuallyUnify variable1 variable2 = do
98 (Record1 fields1 ext1, Record1 fields2 ext2) ->
122 (Record1 fields1 ext1, Record1 fields2 ext2) ->
99 TS.addError "did not write record unification yet" variable1 variable2
123 TS.addError "did not write record unification yet" variable1 variable2
100
124
101− _ -> TS.addError "could not unify types" variable1 variable2
125+ _ -> TS.addError "could not unify types" variable1 variable2
126+