git.iko.soy/elk
on master help sign in
Add definitions for functions that act on numbers and comparables
4e7ef5fEvan Czaplicki
compiler/Type/Environment.hs+29−21
compare with master
unifiedsplit
@@ -44,7 +44,7 @@ makeTypes datatypes =
44 builtins :: [(String,Int)]
44 builtins :: [(String,Int)]
45 builtins = concat [ map tuple [0..9]
45 builtins = concat [ map tuple [0..9]
46 , kind 1 ["_List","Maybe","Signal"]
46 , kind 1 ["_List","Maybe","Signal"]
47− , kind 0 ["Int","Float","Char","Bool","Element"]
47+ , kind 0 ["Int","Float","Char","Bool","Element","Order"]
48 ]
48 ]
49
49
50
50
@@ -56,34 +56,42 @@ makeConstructors types = Map.fromList builtins
56 bool = types ! "Bool"
56 bool = types ! "Bool"
57 int = types ! "Int"
57 int = types ! "Int"
58 float = types ! "Float"
58 float = types ! "Float"
59+ order = types ! "Order"
59
60
61+ instance' :: IO Variable -> Int -> ([Type] -> ([Type], Type))
60− inst :: Int -> Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
62+ -> IO (Int, [Variable], [Type], Type)
61− inst kind numTVars tipe = do
63+ instance' var numTVars tipe = do
62− vars <- forM [1..numTVars] $ \_ -> flexibleVar
64+ vars <- forM [1..numTVars] $ \_ -> var
63 let (args, result) = tipe (map VarN vars)
65 let (args, result) = tipe (map VarN vars)
64− return (kind, vars, args, result)
66+ return (length args, vars, args, result)
65
67
66− nmbr :: Int -> (Type -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
68+ inst = instance' flexibleVar
67− nmbr kind tipe = do
68− var <- number
69+ nmbr = instance' number 1
69− let (args, result) = tipe (VarN var)
70+ cmpr = instance' comparable 1
70− return (kind, [var], args, result)
71+ apnd = instance' appendable 1
71
72
72 tupleCtor n =
73 tupleCtor n =
73 let name = "_Tuple" ++ show n
74 let name = "_Tuple" ++ show n
74− in (name, inst n n $ \vs -> (vs, foldl (<|) (types ! name) vs))
75+ in (name, inst n $ \vs -> (vs, foldl (<|) (types ! name) vs))
75
76
76 builtins :: [ (String, IO (Int, [Variable], [Type], Type)) ]
77 builtins :: [ (String, IO (Int, [Variable], [Type], Type)) ]
77− builtins = [ ("Nothing", inst 0 1 $ \ [t] -> ([], maybe t))
78+ builtins = [ ("Nothing", inst 1 $ \ [t] -> ([], maybe t))
78− , ("Just" , inst 1 1 $ \ [t] -> ([t], maybe t))
79+ , ("Just" , inst 1 $ \ [t] -> ([t], maybe t))
79− , ("[]" , inst 0 1 $ \ [t] -> ([], list t))
80+ , ("[]" , inst 1 $ \ [t] -> ([], list t))
80− , ("::" , inst 2 1 $ \ [t] -> ([t, list t], list t))
81+ , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
81− , ("div" , inst 2 0 $ \ [] -> ([int, int], int))
82+ , ("div" , inst 0 $ \ [] -> ([int, int], int))
82− , ("/" , inst 2 0 $ \ [] -> ([float, float], float))
83+ , ("/" , inst 0 $ \ [] -> ([float, float], float))
83− , ("+" , nmbr 2 $ \t -> ([t, t], t))
84+ , ("+" , nmbr $ \ [t] -> ([t, t], t))
84− , ("-" , nmbr 2 $ \t -> ([t, t], t))
85+ , ("-" , nmbr $ \ [t] -> ([t, t], t))
85− , ("*" , nmbr 2 $ \t -> ([t, t], t))
86+ , ("*" , nmbr $ \ [t] -> ([t, t], t))
87+ , ("<" , cmpr $ \ [t] -> ([t, t], bool))
88+ , (">" , cmpr $ \ [t] -> ([t, t], bool))
89+ , ("<=" , cmpr $ \ [t] -> ([t, t], bool))
90+ , (">=" , cmpr $ \ [t] -> ([t, t], bool))
91+ , ("==" , cmpr $ \ [t] -> ([t, t], bool))
92+ , ("/=" , cmpr $ \ [t] -> ([t, t], bool))
93+ , ("compare", cmpr $ \ [t] -> ([t, t], order))
86− , ("otherwise", inst 0 0 $ \ [] -> ([], bool))
94+ , ("otherwise", inst 0 $ \ [] -> ([], bool))
87 ] ++ map tupleCtor [0..9]
95 ] ++ map tupleCtor [0..9]
88
96
89
97
compiler/Type/Type.hs+21−19
@@ -54,6 +54,25 @@ type TypeScheme = Scheme Type Variable
54
54
55monoscheme headers = Scheme [] [] CTrue headers
55monoscheme headers = Scheme [] [] CTrue headers
56
56
57+infixl 8 /\
58+
59+(/\) :: Constraint a b -> Constraint a b -> Constraint a b
60+a /\ CTrue = a
61+CTrue /\ b = b
62+a /\ b = CAnd [a,b]
63+
64+(===) :: Type -> Type -> TypeConstraint
65+(===) = CEqual
66+
67+(<?) :: SchemeName -> Type -> TypeConstraint
68+x <? t = CInstance x t
69+
70+infixr 9 ==>
71+(==>) :: Type -> Type -> Type
72+a ==> b = TermN (Fun1 a b)
73+
74+f <| a = TermN (App1 f a)
75+
57data Descriptor = Descriptor {
76data Descriptor = Descriptor {
58 structure :: Maybe (Term1 Variable),
77 structure :: Maybe (Term1 Variable),
59 rank :: Int,
78 rank :: Int,
@@ -75,26 +94,9 @@ data Flex = Rigid | Flexible | Constant | IsIn SuperType
75data SuperType = Number | Comparable | Appendable
94data SuperType = Number | Comparable | Appendable
76 deriving (Show, Eq)
95 deriving (Show, Eq)
77
96
78−infixl 8 /\
79−
80−(/\) :: Constraint a b -> Constraint a b -> Constraint a b
81−a /\ CTrue = a
82−CTrue /\ b = b
83−a /\ b = CAnd [a,b]
84−
85−(===) :: Type -> Type -> TypeConstraint
86−(===) = CEqual
87−
88−(<?) :: SchemeName -> Type -> TypeConstraint
89−x <? t = CInstance x t
90−
91−infixr 9 ==>
92−(==>) :: Type -> Type -> Type
93−a ==> b = TermN (Fun1 a b)
94−
95−f <| a = TermN (App1 f a)
96−
97number = namedVar (IsIn Number) "number"
97number = namedVar (IsIn Number) "number"
98+comparable = namedVar (IsIn Comparable) "comparable"
99+appendable = namedVar (IsIn Appendable) "appendable"
98
100
99namedVar flex name = UF.fresh $ Descriptor {
101namedVar flex name = UF.fresh $ Descriptor {
100 structure = Nothing,
102 structure = Nothing,
compiler/Type/Unify.hs+4−4
@@ -81,16 +81,16 @@ actuallyUnify variable1 variable2 = do
81 (IsIn Comparable, IsIn Number, _, _) -> merge2
81 (IsIn Comparable, IsIn Number, _, _) -> merge2
82
82
83 (IsIn Number, _, _, Just name)
83 (IsIn Number, _, _, Just name)
84− | name == "Int" || name == "Float" -> flexAndUnify variable1
84+ | name `elem` ["Int","Float"] -> flexAndUnify variable1
85
85
86 (_, IsIn Number, Just name, _)
86 (_, IsIn Number, Just name, _)
87− | name == "Int" || name == "Float" -> flexAndUnify variable2
87+ | name `elem` ["Int","Float"] -> flexAndUnify variable2
88
88
89 (IsIn Comparable, _, _, Just name)
89 (IsIn Comparable, _, _, Just name)
90− | name == "Int" || name == "Float" -> flexAndUnify variable1
90+ | name `elem` ["Int","Float","Char"] -> flexAndUnify variable1
91
91
92 (_, IsIn Comparable, Just name, _)
92 (_, IsIn Comparable, Just name, _)
93− | name == "Int" || name == "Float" -> flexAndUnify variable2
93+ | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
94
94
95 _ -> TS.addError "The following types are not equal" variable1 variable2
95 _ -> TS.addError "The following types are not equal" variable1 variable2
96
96