diff --git a/elm/src/Types/Constrain.hs b/elm/src/Types/Constrain.hs index f3e8b10..637e3b3 100644 --- a/elm/src/Types/Constrain.hs +++ b/elm/src/Types/Constrain.hs @@ -12,7 +12,7 @@ import Control.Monad.State (evalState) import Guid import Types.Substitutions ---import System.IO.Unsafe +import System.IO.Unsafe prints xs v = v --} unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v @@ -27,7 +27,8 @@ constrain hints (Module _ _ _ stmts) = do assumptions <- foldM insert (unionsA ass) $ map fst (concat schemess) let cs = let f k s vs = map (\v -> Context k $ v :<<: s) vs in concat . Map.elems $ Map.intersectionWithKey f allHints assumptions - return $ cs ++ Set.toList (Set.unions css) + let p = unsafePerformIO (mapM print . Map.toList $ Map.difference assumptions allHints) + seq p . return $ cs ++ Set.toList (Set.unions css) gen :: Expr -> GuidCounter (Map.Map String [X], Set.Set (Context String Constraint), Type) diff --git a/elm/src/Types/Hints.hs b/elm/src/Types/Hints.hs index 9448f58..622d849 100644 --- a/elm/src/Types/Hints.hs +++ b/elm/src/Types/Hints.hs @@ -27,7 +27,9 @@ elements = let iee = int ==> element ==> element in , "width" -: iee , "height" -: iee , "size" -: int ==> iee + , "color" -: color ==> element ==> element , "box" -: iee + , "rectangle" -: int ==> int ==> element , "rightedText" -: text ==> element , "centeredText" -: text ==> element , "justifiedText" -: text ==> element @@ -196,8 +198,12 @@ funcs = , "Nil" -:: listOf a , "Just" -:: a ==> maybeOf a , "Nothing" -:: maybeOf a - , "elmRange" -:: int ==> int ==> listOf int - ] + , "curry" -:: (tupleOf [a,b] ==> c) ==> a ==> b ==> c + , "uncurry" -:: (a ==> b ==> c) ==> tupleOf [a,b] ==> c + ] ++ map tuple [0..8] + +tuple n = ("Tuple" ++ show n, Forall [1..n] [] $ foldr (==>) (tupleOf vs) vs) + where vs = map VarT [1..n] lists = [ "and" -:: listOf bool ==> bool @@ -232,11 +238,20 @@ lists = ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product" , "maximum", "minimum" ] +maybeFuncs = + [ "maybe" -:: b ==> (a ==> b) ==> maybeOf a ==> b + , "isJust" -:: maybeOf a ==> bool + , "isNothing" -:: maybeOf a ==> bool + , "fromMaybe" -:: a ==> maybeOf a ==> a + , "consMaybe" -:: maybeOf a ==> listOf a ==> listOf a + , "catMaybes" -:: listOf (maybeOf a) ==> listOf a + , "catMaybes" -:: (a ==> maybeOf b) ==> listOf a ==> listOf b + ] -------- Everything -------- hints = mapM (\(n,s) -> (,) n `liftM` rescheme s) hs where hs = concat [ funcs, lists, signals, math, bools, str2elem, textAttrs , elements, directions, colors, lineTypes, shapes - , concreteSignals, casts, polyCasts, json + , concreteSignals, casts, polyCasts, json, maybeFuncs ]