git.iko.soy/elk
on master help sign in
Print out a bunch of extra information about type checking.
6fc3032evancz
Elm.cabal−1
compare with master
unifiedsplit
@@ -86,7 +86,6 @@ Library
86Executable elm
86Executable elm
87 Main-is: Compiler.hs
87 Main-is: Compiler.hs
88 Hs-Source-Dirs: compiler, compiler/Gen, compiler/Model, compiler/Transform
88 Hs-Source-Dirs: compiler, compiler/Gen, compiler/Model, compiler/Transform
89− ghc-options: -rtsopts -prof -auto-all -caf-all
90 other-modules: Ast,
89 other-modules: Ast,
91 Located,
90 Located,
92 CompileToJS,
91 CompileToJS,
compiler/Types/Constrain.hs+5−2
@@ -71,6 +71,9 @@ mergeSchemes schmss = do (ass,css,sss) <- unzip3 `liftM` mapM split kvs
71 [] -> []
71 [] -> []
72 , Map.fromList ps )
72 , Map.fromList ps )
73
73
74+--constrain :: Map.Map String Scheme
75+-- -> Module
76+-- -> GuidCounter (Either String Constraints)
74constrain typeHints (Module _ _ imports stmts) = do
77constrain typeHints (Module _ _ imports stmts) = do
75 (ass,css,schemess) <- unzip3 `liftM` mapM stmtGen stmts
78 (ass,css,schemess) <- unzip3 `liftM` mapM stmtGen stmts
76 aliasHints <- getAliases imports `liftM` typeHints
79 aliasHints <- getAliases imports `liftM` typeHints
@@ -86,8 +89,8 @@ constrain typeHints (Module _ _ imports stmts) = do
86 escapees = Map.keys $ Map.difference assumptions allHints
89 escapees = Map.keys $ Map.difference assumptions allHints
87 msg = "Warning! Type-checker could not find variables:\n" ++ intercalate ", " escapees
90 msg = "Warning! Type-checker could not find variables:\n" ++ intercalate ", " escapees
88 return $ case escapees of
91 return $ case escapees of
89− [] -> Right (constraints ++ cs)
92+ [] -> Right (schemess, constraints ++ cs)
90− _ -> unsafePerformIO (putStrLn msg) `seq` Right (constraints ++ cs)
93+ _ -> unsafePerformIO (putStrLn msg) `seq` Right (schemess, constraints ++ cs)
91 --_ -> Left ("Undefined variable(s): " ++ intercalate ", " escapees)
94 --_ -> Left ("Undefined variable(s): " ++ intercalate ", " escapees)
92
95
93type TVarMap = Map.Map String [X]
96type TVarMap = Map.Map String [X]
compiler/Types/Types.hs+2−1
@@ -18,7 +18,8 @@ data Type = LambdaT Type Type
18 | Super (Set.Set Type)
18 | Super (Set.Set Type)
19 deriving (Eq, Ord, Data, Typeable)
19 deriving (Eq, Ord, Data, Typeable)
20
20
21−data Scheme = Forall [X] [Located Constraint] Type deriving (Eq, Ord, Show, Data, Typeable)
21+data Scheme = Forall [X] [Located Constraint] Type
22+ deriving (Eq, Ord, Show, Data, Typeable)
22
23
23data Constraint = Type :=: Type
24data Constraint = Type :=: Type
24 | Type :<: Type
25 | Type :<: Type
compiler/Types/Unify.hs+11−2
@@ -10,7 +10,16 @@ import qualified Types.Constrain as Constrain
10import qualified Types.Solver as Solver
10import qualified Types.Solver as Solver
11import qualified Types.Alias as Alias
11import qualified Types.Alias as Alias
12
12
13+import qualified Types.Substitutions as Subst
14+import System.IO.Unsafe
15+import Control.Arrow (second)
16+
13unify hints modul@(Module _ _ _ stmts) = run $ do
17unify hints modul@(Module _ _ _ stmts) = run $ do
14− constraints <- Constrain.constrain hints modul
18+ result <- Constrain.constrain hints modul
19+ case result of
20+ Left err -> return (Left err)
21+ Right (schemes, constraints) ->
15− either (return . Left) (Solver.solver (Alias.get stmts) Map.empty) constraints
22+ do subs <- Solver.solver (Alias.get stmts) Map.empty constraints
23+ let ss = either (const []) Map.toList subs
24+ unsafePerformIO (mapM print . map (second (Subst.subst ss)) $ concatMap Map.toList schemes) `seq` return subs
16
25