git.iko.soy/elk
on master help sign in
Show realiased types when printing errors and when printing module types
commit4d25352f909ffd2b6d487cbdb2550a23087c305a authorEvan Czaplicki <info@elm-lang.org> dateWed 21 Aug 2013, 19:08 (13 years ago) parente6be50e
3 files changed+20−11
compare with master
unifiedsplit
compiler/Compiler.hs+5−3 compiler/Type/Inference.hs+8−4 compiler/Type/State.hs+7−4
compiler/Compiler.hs+5−3
@@ -31,6 +31,7 @@ import Paths_Elm
3131import SourceSyntax.PrettyPrint (pretty, variable)
3232import Text.PrettyPrint as P
3333import qualified Type.Type as Type
34+import qualified Type.Alias as Alias
3435
3536data Flags =
3637 Flags { make :: Bool
@@ -145,7 +146,7 @@ buildFile flags moduleNum numModules interfaces filePath =
145146 True -> print . pretty $ program modul
146147 return modul
147148
148− if print_types flags then printTypes metaModule else return ()
149+ if print_types flags then printTypes interfaces metaModule else return ()
149150 let interface = Canonical.interface name $ ModuleInterface {
150151 iTypes = types metaModule,
151152 iAdts = datatypes metaModule,
@@ -158,10 +159,11 @@ buildFile flags moduleNum numModules interfaces filePath =
158159 writeFile (elmo flags filePath) (jsModule metaModule)
159160 return (name,interface)
160161
161−printTypes metaModule = do
162+printTypes interfaces metaModule = do
162163 putStrLn ""
164+ let rules = Alias.rules interfaces metaModule
163165 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)
165167 putStrLn ""
166168
167169getRuntime :: Flags -> IO FilePath
compiler/Type/Inference.hs+8−4
@@ -20,6 +20,7 @@ import Control.Monad.State
2020import Control.Arrow (second)
2121import Transform.SortDefinitions as Sort
2222import qualified Data.Traversable as Traverse
23+import qualified Type.Alias as Alias
2324
2425import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
2526 -- the IO monad. I don't think that'd be worthwhile.
@@ -48,8 +49,11 @@ infer interfaces modul = unsafePerformIO $ do
4849
4950 state <- execStateT (Solve.solve constraint) TS.initialState
5051 case TS.sErrors state of
51− errors@(_:_) -> Left `fmap` sequence (reverse errors)
52− [] -> let types = Map.difference (TS.sSavedEnv state) header in
53− do srcTypes <- Traverse.traverse T.toSrcType types
54− return $ Right srcTypes
52+ errors@(_:_) ->
53+ let rules = Alias.rules interfaces modul in
54+ Left `fmap` sequence (map ($ rules) (reverse errors))
55+ [] ->
56+ let types = Map.difference (TS.sSavedEnv state) header in
57+ do srcTypes <- Traverse.traverse T.toSrcType types
58+ return $ Right srcTypes
5559
compiler/Type/State.hs+7−4
@@ -11,6 +11,8 @@ import qualified Data.Traversable as Traversable
1111import Text.PrettyPrint as P
1212import SourceSyntax.PrettyPrint
1313import SourceSyntax.Location
14+import qualified SourceSyntax.Type as Src
15+import qualified Type.Alias as Alias
1416
1517-- Pool
1618-- Holds a bunch of variables
@@ -32,7 +34,7 @@ data SolverState = SS {
3234 sSavedEnv :: Env,
3335 sPool :: Pool,
3436 sMark :: Int,
35− sErrors :: [IO P.Doc]
37+ sErrors :: [Alias.Rules -> IO P.Doc]
3638}
3739
3840initialState = SS {
@@ -49,9 +51,10 @@ modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
4951addError span message t1 t2 =
5052 modify $ \state -> state { sErrors = makeError : sErrors state }
5153 where
52− makeError = do
53− t1' <- pretty <$> toSrcType t1
54− t2' <- pretty <$> toSrcType t2
54+ makeError rules = do
55+ let prettiest = pretty . Alias.realias rules
56+ t1' <- prettiest <$> toSrcType t1
57+ t2' <- prettiest <$> toSrcType t2
5558 return . P.vcat $
5659 [ P.text $ "Type error" ++ location ++ ":"
5760 , P.vcat . map P.text . lines $ if null message then defaultMessage else message