git.iko.soy/elk
on master help sign in
Add the 'Appendable' super-type and add hints for new number functions.
commit0a4010e7dad0a98d176b6b6d0761f8a2d26c347f authorevancz <info@elm-lang.org> dateSun 22 Jul 2012, 00:50 (14 years ago) parent79e465c
3 files changed+33−15
compare with master
unifiedsplit
elm/src/Types/Hints.hs+16−7 elm/src/Types/Types.hs+5−3 elm/src/Types/Unify.hs+12−5
elm/src/Types/Hints.hs+16−7
@@ -43,11 +43,11 @@ lineTypes = [ numScheme (\n -> listOf (pairOf n) ==> line) "line"
4343 , "customLine" -: listOf int ==> color ==> line ==> form
4444 ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]
4545
46−shapes = [ numScheme (\n -> listOf (pairOf n) ==> pairOf n ==> shape) "polygon"
46+shapes = [ twoNums (\n m -> listOf (pairOf n) ==> pairOf m ==> shape) "polygon"
4747 , "filled" -: color ==> shape ==> form
4848 , "outlined" -: color ==> shape ==> form
4949 , "customOutline" -: listOf int ==> color ==> shape ==> form
50− ] ++ map (numScheme (\n -> n ==> n ==> pairOf n ==> shape)) [ "ngon"
50+ ] ++ map (twoNums (\n m -> n ==> n ==> pairOf m ==> shape)) [ "ngon"
5151 , "rect"
5252 , "oval" ]
5353
@@ -130,6 +130,9 @@ concreteSignals =
130130binop t = t ==> t ==> t
131131numScheme t name = (name, Forall [0] [VarT 0 :<: number] (t (VarT 0)))
132132timeScheme name t = (name, Forall [0] [VarT 0 :<: time] (t (VarT 0)))
133+twoNums f name =
134+ (,) name . Forall [0,1] [ VarT 0 :<: number, VarT 1 :<: number ] $
135+ f (VarT 0) (VarT 1)
133136
134137math =
135138 map (numScheme (\t -> t ==> binop t)) ["clamp"] ++
@@ -137,7 +140,10 @@ math =
137140 [ numScheme (\t -> t ==> t) "abs" ] ++
138141 hasType (binop float) [ "/", "logBase" ] ++
139142 hasType (binop int) ["rem","div","mod"] ++
140− hasType (float ==> float) ["sin","cos","tan","asin","acos","atan","sqrt"]
143+ hasType (float ==> float) ["sin","cos","tan","asin","acos","atan","sqrt"] ++
144+ hasType float ["pi","e"] ++
145+ hasType (int ==> float) ["toFloat","castIntToFloat"] ++
146+ hasType (float ==> int) ["round","floor","ceiling","truncate"]
141147
142148bools =
143149 [ "not" -: bool ==> bool ] ++
@@ -163,7 +169,7 @@ funcs =
163169 , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)
164170 , "$" -:: (a ==> b) ==> a ==> b
165171 , ":" -:: a ==> listOf a ==> listOf a
166− , "++" -:: a ==> a ==> a
172+ , (,) "++" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0
167173 , "Cons" -:: a ==> listOf a ==> listOf a
168174 , "Nil" -:: listOf a
169175 , "Just" -:: a ==> maybeOf a
@@ -184,19 +190,22 @@ lists =
184190 , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a
185191 , "forall" -:: (a ==> bool) ==> listOf a ==> bool
186192 , "exists" -:: (a ==> bool) ==> listOf a ==> bool
187− , "concat" -:: listOf (listOf a) ==> listOf a
188193 , "reverse" -:: listOf a ==> listOf a
189194 , "take" -:: int ==> listOf a ==> listOf a
190195 , "drop" -:: int ==> listOf a ==> listOf a
191196 , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]
192197 , "intersperse" -:: a ==> listOf a ==> listOf a
193− , "intercalate" -:: listOf a ==> listOf(listOf a) ==> listOf a
194198 , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])
195199 , "map" -:: (a ==> b) ==> listOf a ==> listOf b
196200 , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
197201 , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b
198202 , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b
199− , "concatMap" -:: (a ==> listOf b) ==> listOf a ==> listOf b
203+ , (,) "concat" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $
204+ listOf (VarT 0) ==> VarT 0
205+ , (,) "concatMap" . Forall [0,1,2] [ VarT 0 :<: appendable (VarT 1) ] $
206+ (VarT 2 ==> VarT 0) ==> listOf (VarT 2) ==> VarT 0
207+ , (,) "intercalate" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $
208+ VarT 0 ==> listOf (VarT 0) ==> VarT 0
200209 , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c
201210 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
202211 , "maximum", "minimum" ]
elm/src/Types/Types.hs+5−3
@@ -31,10 +31,10 @@ number = SuperType "Number" (Set.fromList [ int, float ])
3131char = tipe "Char"
3232bool = tipe "Bool"
3333
34−string = tipe "String"
34+string = listOf char -- tipe "String"
3535text = tipe "Text"
3636
37−time = SuperType "Time" (Set.fromList [ int, float ])
37+time = SuperType "Time" (Set.fromList [ int, float, tipe "Number" ])
3838
3939element = tipe "Element"
4040direction = tipe "Direction"
@@ -49,6 +49,7 @@ tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts
4949maybeOf t = ADT "Maybe" [t]
5050pairOf t = tupleOf [t,t]
5151point = pairOf int
52+appendable t = SuperType "Appendable" (Set.fromList [ string, text, listOf t ])
5253
5354jsBool = tipe "JSBool"
5455jsNumber = tipe "JSNumber"
@@ -72,7 +73,8 @@ instance Show Type where
7273 case t of
7374 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2
7475 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2
75− ; VarT x -> show x
76+ ; VarT x -> 't' : show x
77+ ; ADT "List" [ADT "Char" []] -> "String"
7678 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"
7779 ; ADT name cs ->
7880 if isTupleString name
elm/src/Types/Unify.hs+12−5
@@ -30,8 +30,9 @@ solver ((LambdaT t1 t2 :=: LambdaT t1' t2') : cs) subs =
3030solver ((VarT x :=: t) : cs) subs =
3131 solver (map (cSub x t) cs) . map (second $ tSub x t) $ (x,t):subs
3232solver ((t :=: VarT x) : cs) subs = solver ((VarT x :=: t) : cs) subs
33−solver ((t1 :=: t2) : cs) subs =
34− if t1 /= t2 then uniError t1 t2 else solver cs subs
33+solver ((t1 :=: t2) : cs) subs
34+ | t1 == t2 = solver cs subs
35+ | otherwise = uniError t1 t2
3536
3637-------- subtypes --------
3738
@@ -43,11 +44,18 @@ solver (c@(VarT x :<: SuperType n ts) : cs) subs
4344solver ((t@(ADT n1 []) :<: st@(SuperType n2 ts)) : cs) subs
4445 | n1 == n2 || Set.member t ts = solver cs subs
4546 | otherwise = return . Left $ "Type error: " ++ show t ++
46− " is not a subtype of " ++ show st
47+ " is not a " ++ show st
48+solver ((t@(ADT "List" [_]) :<: st@(SuperType n' ts')) : cs) subs
49+ | any f (Set.toList ts') = solver cs subs
50+ | otherwise = return . Left $ "Type error: " ++ show t ++
51+ " is not a " ++ show st
52+ where f (ADT "List" [VarT _]) = True
53+ f _ = False
54+
4755solver ((t :<: st@(SuperType n ts)) : cs) subs
4856 | Set.member t ts = solver cs subs
4957 | otherwise = return . Left $ "Type error: " ++ show t ++
50− " is not a subtype of " ++ show st
58+ " is not a " ++ show st
5159
5260solver ((t1 :<<: Forall xs cs' t2) : cs) subs = do
5361 pairs <- mapM (\x -> liftM ((,) x . VarT) guid) xs
@@ -63,7 +71,6 @@ cSub k v (t :<<: poly) = force $ tSub k v t :<<: poly
6371tSub k v t@(VarT x) = if k == x then v else t
6472tSub k v (LambdaT t1 t2) = force $ LambdaT (tSub k v t1) (tSub k v t2)
6573tSub k v (ADT name ts) = ADT name (map (force . tSub k v) ts)
66−tSub _ _ t = t
6774
6875uniError t1 t2 =
6976 return . Left $ "Type error: " ++ show t1 ++ " is not equal to " ++ show t2