git.iko.soy/elk
on master help sign in
Add definitions for functions that act on numbers and comparables

This will get moved into Elm code eventually

commit4e7ef5f1777e93f58f20a090db29793f22a145af authorEvan Czaplicki <info@elm-lang.org> dateThu 25 Jul 2013, 14:54 (13 years ago) parentd456cec
3 files changed+54−44
compare with master
unifiedsplit
compiler/Type/Environment.hs+29−21 compiler/Type/Type.hs+21−19 compiler/Type/Unify.hs+4−4
compiler/Type/Environment.hs+29−21
@@ -44,7 +44,7 @@ makeTypes datatypes =
4444 builtins :: [(String,Int)]
4545 builtins = concat [ map tuple [0..9]
4646 , kind 1 ["_List","Maybe","Signal"]
47− , kind 0 ["Int","Float","Char","Bool","Element"]
47+ , kind 0 ["Int","Float","Char","Bool","Element","Order"]
4848 ]
4949
5050
@@ -56,34 +56,42 @@ makeConstructors types = Map.fromList builtins
5656 bool = types ! "Bool"
5757 int = types ! "Int"
5858 float = types ! "Float"
59+ order = types ! "Order"
5960
60− inst :: Int -> Int -> ([Type] -> ([Type], Type)) -> IO (Int, [Variable], [Type], Type)
61− inst kind numTVars tipe = do
62− vars <- forM [1..numTVars] $ \_ -> flexibleVar
61+ instance' :: IO Variable -> Int -> ([Type] -> ([Type], Type))
62+ -> IO (Int, [Variable], [Type], Type)
63+ instance' var numTVars tipe = do
64+ vars <- forM [1..numTVars] $ \_ -> var
6365 let (args, result) = tipe (map VarN vars)
64− return (kind, vars, args, result)
66+ return (length args, vars, args, result)
6567
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)
68+ inst = instance' flexibleVar
69+ nmbr = instance' number 1
70+ cmpr = instance' comparable 1
71+ apnd = instance' appendable 1
7172
7273 tupleCtor n =
7374 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))
7576
7677 builtins :: [ (String, IO (Int, [Variable], [Type], Type)) ]
77− builtins = [ ("Nothing", inst 0 1 $ \ [t] -> ([], maybe t))
78− , ("Just" , inst 1 1 $ \ [t] -> ([t], maybe t))
79− , ("[]" , inst 0 1 $ \ [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))
78+ builtins = [ ("Nothing", inst 1 $ \ [t] -> ([], maybe t))
79+ , ("Just" , inst 1 $ \ [t] -> ([t], maybe t))
80+ , ("[]" , inst 1 $ \ [t] -> ([], list t))
81+ , ("::" , inst 1 $ \ [t] -> ([t, list t], list t))
82+ , ("div" , inst 0 $ \ [] -> ([int, int], int))
83+ , ("/" , inst 0 $ \ [] -> ([float, float], float))
84+ , ("+" , nmbr $ \ [t] -> ([t, t], t))
85+ , ("-" , nmbr $ \ [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))
94+ , ("otherwise", inst 0 $ \ [] -> ([], bool))
8795 ] ++ map tupleCtor [0..9]
8896
8997
compiler/Type/Type.hs+21−19
@@ -54,6 +54,25 @@ type TypeScheme = Scheme Type Variable
5454
5555monoscheme headers = Scheme [] [] CTrue headers
5656
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+
5776data Descriptor = Descriptor {
5877 structure :: Maybe (Term1 Variable),
5978 rank :: Int,
@@ -75,26 +94,9 @@ data Flex = Rigid | Flexible | Constant | IsIn SuperType
7594data SuperType = Number | Comparable | Appendable
7695 deriving (Show, Eq)
7796
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−
9797number = namedVar (IsIn Number) "number"
98+comparable = namedVar (IsIn Comparable) "comparable"
99+appendable = namedVar (IsIn Appendable) "appendable"
98100
99101namedVar flex name = UF.fresh $ Descriptor {
100102 structure = Nothing,
compiler/Type/Unify.hs+4−4
@@ -81,16 +81,16 @@ actuallyUnify variable1 variable2 = do
8181 (IsIn Comparable, IsIn Number, _, _) -> merge2
8282
8383 (IsIn Number, _, _, Just name)
84− | name == "Int" || name == "Float" -> flexAndUnify variable1
84+ | name `elem` ["Int","Float"] -> flexAndUnify variable1
8585
8686 (_, IsIn Number, Just name, _)
87− | name == "Int" || name == "Float" -> flexAndUnify variable2
87+ | name `elem` ["Int","Float"] -> flexAndUnify variable2
8888
8989 (IsIn Comparable, _, _, Just name)
90− | name == "Int" || name == "Float" -> flexAndUnify variable1
90+ | name `elem` ["Int","Float","Char"] -> flexAndUnify variable1
9191
9292 (_, IsIn Comparable, Just name, _)
93− | name == "Int" || name == "Float" -> flexAndUnify variable2
93+ | name `elem` ["Int","Float","Char"] -> flexAndUnify variable2
9494
9595 _ -> TS.addError "The following types are not equal" variable1 variable2
9696