0a4010e · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Add the 'Appendable' super-type and add hints for new number functions.

0a4010eevancz14 years ago

elm/src/Types/Hints.hs+16−7

compare with master

unifiedsplit

@@ -43,11 +43,11 @@ lineTypes = [ numScheme (\n -> listOf (pairOf n) ==> line) "line"

43 , "customLine" -: listOf int ==> color ==> line ==> form

44 ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]

46−shapes = [ numScheme (\n -> listOf (pairOf n) ==> pairOf n ==> shape) "polygon"

46+shapes = [ twoNums (\n m -> listOf (pairOf n) ==> pairOf m ==> shape) "polygon"

47 , "filled" -: color ==> shape ==> form

48 , "outlined" -: color ==> shape ==> form

49 , "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"

51 , "rect"

52 , "oval" ]

@@ -130,6 +130,9 @@ concreteSignals =

130binop t = t ==> t ==> t

131numScheme t name = (name, Forall [0] [VarT 0 :<: number] (t (VarT 0)))

132timeScheme 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)

133

136

134math =

137math =

135 map (numScheme (\t -> t ==> binop t)) ["clamp"] ++

138 map (numScheme (\t -> t ==> binop t)) ["clamp"] ++

@@ -137,7 +140,10 @@ math =

137 [ numScheme (\t -> t ==> t) "abs" ] ++

140 [ numScheme (\t -> t ==> t) "abs" ] ++

138 hasType (binop float) [ "/", "logBase" ] ++

141 hasType (binop float) [ "/", "logBase" ] ++

139 hasType (binop int) ["rem","div","mod"] ++

142 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"]

141

147

142bools =

148bools =

143 [ "not" -: bool ==> bool ] ++

149 [ "not" -: bool ==> bool ] ++

@@ -163,7 +169,7 @@ funcs =

163 , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)

169 , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)

164 , "$" -:: (a ==> b) ==> a ==> b

170 , "$" -:: (a ==> b) ==> a ==> b

165 , ":" -:: a ==> listOf a ==> listOf a

171 , ":" -:: a ==> listOf a ==> listOf a

166− , "++" -:: a ==> a ==> a

172+ , (,) "++" . Forall [0,1] [ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0

167 , "Cons" -:: a ==> listOf a ==> listOf a

173 , "Cons" -:: a ==> listOf a ==> listOf a

168 , "Nil" -:: listOf a

174 , "Nil" -:: listOf a

169 , "Just" -:: a ==> maybeOf a

175 , "Just" -:: a ==> maybeOf a

@@ -184,19 +190,22 @@ lists =

184 , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a

190 , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a

185 , "forall" -:: (a ==> bool) ==> listOf a ==> bool

191 , "forall" -:: (a ==> bool) ==> listOf a ==> bool

186 , "exists" -:: (a ==> bool) ==> listOf a ==> bool

192 , "exists" -:: (a ==> bool) ==> listOf a ==> bool

187− , "concat" -:: listOf (listOf a) ==> listOf a

188 , "reverse" -:: listOf a ==> listOf a

193 , "reverse" -:: listOf a ==> listOf a

189 , "take" -:: int ==> listOf a ==> listOf a

194 , "take" -:: int ==> listOf a ==> listOf a

190 , "drop" -:: int ==> listOf a ==> listOf a

195 , "drop" -:: int ==> listOf a ==> listOf a

191 , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]

196 , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]

192 , "intersperse" -:: a ==> listOf a ==> listOf a

197 , "intersperse" -:: a ==> listOf a ==> listOf a

193− , "intercalate" -:: listOf a ==> listOf(listOf a) ==> listOf a

194 , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])

198 , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])

195 , "map" -:: (a ==> b) ==> listOf a ==> listOf b

199 , "map" -:: (a ==> b) ==> listOf a ==> listOf b

196 , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b

200 , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b

197 , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b

201 , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b

198 , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b

202 , "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

200 , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c

209 , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c

201 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"

210 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"

202 , "maximum", "minimum" ]

211 , "maximum", "minimum" ]

elm/src/Types/Types.hs+5−3

@@ -31,10 +31,10 @@ number = SuperType "Number" (Set.fromList [ int, float ])

31char = tipe "Char"

32bool = tipe "Bool"

34−string = tipe "String"

34+string = listOf char -- tipe "String"

35text = tipe "Text"

37−time = SuperType "Time" (Set.fromList [ int, float ])

37+time = SuperType "Time" (Set.fromList [ int, float, tipe "Number" ])

39element = tipe "Element"

40direction = tipe "Direction"

@@ -49,6 +49,7 @@ tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts

49maybeOf t = ADT "Maybe" [t]

50pairOf t = tupleOf [t,t]

51point = pairOf int

52+appendable t = SuperType "Appendable" (Set.fromList [ string, text, listOf t ])

53jsBool = tipe "JSBool"

54jsBool = tipe "JSBool"

54jsNumber = tipe "JSNumber"

55jsNumber = tipe "JSNumber"

@@ -72,7 +73,8 @@ instance Show Type where

72 case t of

73 case t of

73 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2

74 { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2

74 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2

75 ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2

75− ; VarT x -> show x

76+ ; VarT x -> 't' : show x

77+ ; ADT "List" [ADT "Char" []] -> "String"

76 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"

78 ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"

77 ; ADT name cs ->

79 ; ADT name cs ->

78 if isTupleString name

80 if isTupleString name

elm/src/Types/Unify.hs+12−5

@@ -30,8 +30,9 @@ solver ((LambdaT t1 t2 :=: LambdaT t1' t2') : cs) subs =

30solver ((VarT x :=: t) : cs) subs =

31 solver (map (cSub x t) cs) . map (second $ tSub x t) $ (x,t):subs

32solver ((t :=: VarT x) : cs) subs = solver ((VarT x :=: t) : cs) subs

33−solver ((t1 :=: t2) : cs) subs =

33+solver ((t1 :=: t2) : cs) subs

34+ | t1 == t2 = solver cs subs

34− if t1 /= t2 then uniError t1 t2 else solver cs subs

35+ | otherwise = uniError t1 t2

36-------- subtypes --------

37-------- subtypes --------

@@ -43,11 +44,18 @@ solver (c@(VarT x :<: SuperType n ts) : cs) subs

43solver ((t@(ADT n1 []) :<: st@(SuperType n2 ts)) : cs) subs

44solver ((t@(ADT n1 []) :<: st@(SuperType n2 ts)) : cs) subs

44 | n1 == n2 || Set.member t ts = solver cs subs

45 | n1 == n2 || Set.member t ts = solver cs subs

45 | otherwise = return . Left $ "Type error: " ++ show t ++

46 | 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+

47solver ((t :<: st@(SuperType n ts)) : cs) subs

55solver ((t :<: st@(SuperType n ts)) : cs) subs

48 | Set.member t ts = solver cs subs

56 | Set.member t ts = solver cs subs

49 | otherwise = return . Left $ "Type error: " ++ show t ++

57 | otherwise = return . Left $ "Type error: " ++ show t ++

50− " is not a subtype of " ++ show st

58+ " is not a " ++ show st

52solver ((t1 :<<: Forall xs cs' t2) : cs) subs = do

60solver ((t1 :<<: Forall xs cs' t2) : cs) subs = do

53 pairs <- mapM (\x -> liftM ((,) x . VarT) guid) xs

61 pairs <- mapM (\x -> liftM ((,) x . VarT) guid) xs

@@ -63,7 +71,6 @@ cSub k v (t :<<: poly) = force $ tSub k v t :<<: poly

63tSub k v t@(VarT x) = if k == x then v else t

71tSub k v t@(VarT x) = if k == x then v else t

64tSub k v (LambdaT t1 t2) = force $ LambdaT (tSub k v t1) (tSub k v t2)

72tSub k v (LambdaT t1 t2) = force $ LambdaT (tSub k v t1) (tSub k v t2)

65tSub k v (ADT name ts) = ADT name (map (force . tSub k v) ts)

73tSub k v (ADT name ts) = ADT name (map (force . tSub k v) ts)

66−tSub _ _ t = t

68uniError t1 t2 =

75uniError t1 t2 =

69 return . Left $ "Type error: " ++ show t1 ++ " is not equal to " ++ show t2

76 return . Left $ "Type error: " ++ show t1 ++ " is not equal to " ++ show t2