git.iko.soy/elk
on master help sign in
Show realiased types when printing errors and when printing module types
4d25352Evan Czaplicki
compiler/Compiler.hs+5−3
compare with master
unifiedsplit
@@ -31,6 +31,7 @@ import Paths_Elm
31import SourceSyntax.PrettyPrint (pretty, variable)
31import SourceSyntax.PrettyPrint (pretty, variable)
32import Text.PrettyPrint as P
32import Text.PrettyPrint as P
33import qualified Type.Type as Type
33import qualified Type.Type as Type
34+import qualified Type.Alias as Alias
34
35
35data Flags =
36data Flags =
36 Flags { make :: Bool
37 Flags { make :: Bool
@@ -145,7 +146,7 @@ buildFile flags moduleNum numModules interfaces filePath =
145 True -> print . pretty $ program modul
146 True -> print . pretty $ program modul
146 return modul
147 return modul
147
148
148− if print_types flags then printTypes metaModule else return ()
149+ if print_types flags then printTypes interfaces metaModule else return ()
149 let interface = Canonical.interface name $ ModuleInterface {
150 let interface = Canonical.interface name $ ModuleInterface {
150 iTypes = types metaModule,
151 iTypes = types metaModule,
151 iAdts = datatypes metaModule,
152 iAdts = datatypes metaModule,
@@ -158,10 +159,11 @@ buildFile flags moduleNum numModules interfaces filePath =
158 writeFile (elmo flags filePath) (jsModule metaModule)
159 writeFile (elmo flags filePath) (jsModule metaModule)
159 return (name,interface)
160 return (name,interface)
160
161
161−printTypes metaModule = do
162+printTypes interfaces metaModule = do
162 putStrLn ""
163 putStrLn ""
164+ let rules = Alias.rules interfaces metaModule
163 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
165 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
164− print $ variable n <+> P.text ":" <+> pretty t
166+ print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
165 putStrLn ""
167 putStrLn ""
166
168
167getRuntime :: Flags -> IO FilePath
169getRuntime :: Flags -> IO FilePath
compiler/Type/Inference.hs+8−4
@@ -20,6 +20,7 @@ import Control.Monad.State
20import Control.Arrow (second)
20import Control.Arrow (second)
21import Transform.SortDefinitions as Sort
21import Transform.SortDefinitions as Sort
22import qualified Data.Traversable as Traverse
22import qualified Data.Traversable as Traverse
23+import qualified Type.Alias as Alias
23
24
24import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
25import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
25 -- the IO monad. I don't think that'd be worthwhile.
26 -- the IO monad. I don't think that'd be worthwhile.
@@ -48,8 +49,11 @@ infer interfaces modul = unsafePerformIO $ do
48
49
49 state <- execStateT (Solve.solve constraint) TS.initialState
50 state <- execStateT (Solve.solve constraint) TS.initialState
50 case TS.sErrors state of
51 case TS.sErrors state of
52+ errors@(_:_) ->
53+ let rules = Alias.rules interfaces modul in
51− errors@(_:_) -> Left `fmap` sequence (reverse errors)
54+ Left `fmap` sequence (map ($ rules) (reverse errors))
55+ [] ->
52− [] -> let types = Map.difference (TS.sSavedEnv state) header in
56+ let types = Map.difference (TS.sSavedEnv state) header in
53− do srcTypes <- Traverse.traverse T.toSrcType types
57+ do srcTypes <- Traverse.traverse T.toSrcType types
54− return $ Right srcTypes
58+ return $ Right srcTypes
55
59
compiler/Type/State.hs+7−4
@@ -11,6 +11,8 @@ import qualified Data.Traversable as Traversable
11import Text.PrettyPrint as P
11import Text.PrettyPrint as P
12import SourceSyntax.PrettyPrint
12import SourceSyntax.PrettyPrint
13import SourceSyntax.Location
13import SourceSyntax.Location
14+import qualified SourceSyntax.Type as Src
15+import qualified Type.Alias as Alias
14
16
15-- Pool
17-- Pool
16-- Holds a bunch of variables
18-- Holds a bunch of variables
@@ -32,7 +34,7 @@ data SolverState = SS {
32 sSavedEnv :: Env,
34 sSavedEnv :: Env,
33 sPool :: Pool,
35 sPool :: Pool,
34 sMark :: Int,
36 sMark :: Int,
35− sErrors :: [IO P.Doc]
37+ sErrors :: [Alias.Rules -> IO P.Doc]
36}
38}
37
39
38initialState = SS {
40initialState = SS {
@@ -49,9 +51,10 @@ modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
49addError span message t1 t2 =
51addError span message t1 t2 =
50 modify $ \state -> state { sErrors = makeError : sErrors state }
52 modify $ \state -> state { sErrors = makeError : sErrors state }
51 where
53 where
52− makeError = do
54+ makeError rules = do
55+ let prettiest = pretty . Alias.realias rules
53− t1' <- pretty <$> toSrcType t1
56+ t1' <- prettiest <$> toSrcType t1
54− t2' <- pretty <$> toSrcType t2
57+ t2' <- prettiest <$> toSrcType t2
55 return . P.vcat $
58 return . P.vcat $
56 [ P.text $ "Type error" ++ location ++ ":"
59 [ P.text $ "Type error" ++ location ++ ":"
57 , P.vcat . map P.text . lines $ if null message then defaultMessage else message
60 , P.vcat . map P.text . lines $ if null message then defaultMessage else message