on master help sign in
Add some type hints and print out any assumptions that escape type checking.
8810898evancz
elm/src/Types/Constrain.hs+3−2
@@ -12,7 +12,7 @@ import Control.Monad.State (evalState)
12import Guid
12import Guid
13import Types.Substitutions
13import Types.Substitutions
14
14
15−--import System.IO.Unsafe
15+import System.IO.Unsafe
16
16
17prints xs v = v --} unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v
17prints xs v = v --} unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v
18
18
@@ -27,7 +27,8 @@ constrain hints (Module _ _ _ stmts) = do
27 assumptions <- foldM insert (unionsA ass) $ map fst (concat schemess)
27 assumptions <- foldM insert (unionsA ass) $ map fst (concat schemess)
28 let cs = let f k s vs = map (\v -> Context k $ v :<<: s) vs in
28 let cs = let f k s vs = map (\v -> Context k $ v :<<: s) vs in
29 concat . Map.elems $ Map.intersectionWithKey f allHints assumptions
29 concat . Map.elems $ Map.intersectionWithKey f allHints assumptions
30+ let p = unsafePerformIO (mapM print . Map.toList $ Map.difference assumptions allHints)
30− return $ cs ++ Set.toList (Set.unions css)
31+ seq p . return $ cs ++ Set.toList (Set.unions css)
31
32
32gen :: Expr -> GuidCounter (Map.Map String [X], Set.Set (Context String Constraint), Type)
33gen :: Expr -> GuidCounter (Map.Map String [X], Set.Set (Context String Constraint), Type)
33
34
elm/src/Types/Hints.hs+18−3
@@ -27,7 +27,9 @@ elements = let iee = int ==> element ==> element in
27 , "width" -: iee
27 , "width" -: iee
28 , "height" -: iee
28 , "height" -: iee
29 , "size" -: int ==> iee
29 , "size" -: int ==> iee
30+ , "color" -: color ==> element ==> element
30 , "box" -: iee
31 , "box" -: iee
32+ , "rectangle" -: int ==> int ==> element
31 , "rightedText" -: text ==> element
33 , "rightedText" -: text ==> element
32 , "centeredText" -: text ==> element
34 , "centeredText" -: text ==> element
33 , "justifiedText" -: text ==> element
35 , "justifiedText" -: text ==> element
@@ -196,8 +198,12 @@ funcs =
196 , "Nil" -:: listOf a
198 , "Nil" -:: listOf a
197 , "Just" -:: a ==> maybeOf a
199 , "Just" -:: a ==> maybeOf a
198 , "Nothing" -:: maybeOf a
200 , "Nothing" -:: maybeOf a
199− , "elmRange" -:: int ==> int ==> listOf int
201+ , "curry" -:: (tupleOf [a,b] ==> c) ==> a ==> b ==> c
200− ]
202+ , "uncurry" -:: (a ==> b ==> c) ==> tupleOf [a,b] ==> c
203+ ] ++ map tuple [0..8]
204+
205+tuple n = ("Tuple" ++ show n, Forall [1..n] [] $ foldr (==>) (tupleOf vs) vs)
206+ where vs = map VarT [1..n]
201
207
202lists =
208lists =
203 [ "and" -:: listOf bool ==> bool
209 [ "and" -:: listOf bool ==> bool
@@ -232,11 +238,20 @@ lists =
232 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
238 ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"
233 , "maximum", "minimum" ]
239 , "maximum", "minimum" ]
234
240
241+maybeFuncs =
242+ [ "maybe" -:: b ==> (a ==> b) ==> maybeOf a ==> b
243+ , "isJust" -:: maybeOf a ==> bool
244+ , "isNothing" -:: maybeOf a ==> bool
245+ , "fromMaybe" -:: a ==> maybeOf a ==> a
246+ , "consMaybe" -:: maybeOf a ==> listOf a ==> listOf a
247+ , "catMaybes" -:: listOf (maybeOf a) ==> listOf a
248+ , "catMaybes" -:: (a ==> maybeOf b) ==> listOf a ==> listOf b
249+ ]
235
250
236-------- Everything --------
251-------- Everything --------
237
252
238hints = mapM (\(n,s) -> (,) n `liftM` rescheme s) hs
253hints = mapM (\(n,s) -> (,) n `liftM` rescheme s) hs
239 where hs = concat [ funcs, lists, signals, math, bools, str2elem, textAttrs
254 where hs = concat [ funcs, lists, signals, math, bools, str2elem, textAttrs
240 , elements, directions, colors, lineTypes, shapes
255 , elements, directions, colors, lineTypes, shapes
241− , concreteSignals, casts, polyCasts, json
256+ , concreteSignals, casts, polyCasts, json, maybeFuncs
242 ]
257 ]