on master help sign in
Switch to SrcTypes after type inference, not in compiler
commit7093436b139b77a24a03f1deb9b157d4a9604f80 authorEvan Czaplicki <info@elm-lang.org> dateWed 21 Aug 2013, 14:23 (13 years ago) parentbdb3102
3 files changed+11−12
compiler/Compiler.hs+2−5 compiler/SourceSyntax/Module.hs+1−2 compiler/Type/Inference.hs+8−5
compiler/Compiler.hs+2−5
@@ -31,7 +31,6 @@ import Paths_Elm
3131import SourceSyntax.PrettyPrint (pretty, variable)
3232import Text.PrettyPrint as P
3333import qualified Type.Type as Type
34−import qualified Data.Traversable as Traverse
3534
3635data Flags =
3736 Flags { make :: Bool
@@ -147,9 +146,8 @@ buildFile flags moduleNum numModules interfaces filePath =
147146 return modul
148147
149148 if print_types flags then printTypes metaModule else return ()
150− tipes <- Traverse.traverse Type.toSrcType (types metaModule)
151149 let interface = Canonical.interface name $ ModuleInterface {
152− iTypes = tipes,
150+ iTypes = types metaModule,
153151 iAdts = datatypes metaModule,
154152 iAliases = aliases metaModule
155153 }
@@ -163,8 +161,7 @@ buildFile flags moduleNum numModules interfaces filePath =
163161printTypes metaModule = do
164162 putStrLn ""
165163 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do
166− pt <- Type.extraPretty t
167− print $ variable n <+> P.text ":" <+> pt
164+ print $ variable n <+> P.text ":" <+> pretty t
168165 putStrLn ""
169166
170167getRuntime :: Flags -> IO FilePath
compiler/SourceSyntax/Module.hs+1−2
@@ -12,7 +12,6 @@ import SourceSyntax.Expression (LExpr)
1212import SourceSyntax.Declaration
1313import SourceSyntax.Type
1414import System.FilePath (joinPath)
15−import qualified Type.Type as Type
1615
1716data Module tipe var =
1817 Module [String] Exports Imports [Declaration tipe var]
@@ -30,7 +29,7 @@ data MetadataModule t v = MetadataModule {
3029 exports :: [String],
3130 imports :: [(String, ImportMethod)],
3231 program :: LExpr t v,
33− types :: Map.Map String Type.Variable,
32+ types :: Map.Map String Type,
3433 fixities :: [(Assoc, Int, String)],
3534 aliases :: [(String, [String], Type)],
3635 datatypes :: [ (String, [String], [(String,[Type])]) ],
compiler/Type/Inference.hs+8−5
@@ -12,18 +12,20 @@ import SourceSyntax.Module as Module
1212import qualified SourceSyntax.Expression as Expr
1313import SourceSyntax.Location (Located, noneNoDocs)
1414import SourceSyntax.PrettyPrint
15+import SourceSyntax.Type (Type)
1516import Text.PrettyPrint
1617import qualified Type.State as TS
1718import Type.ExtraChecks (extraChecks)
1819import Control.Monad.State
1920import Control.Arrow (second)
2021import Transform.SortDefinitions as Sort
22+import qualified Data.Traversable as Traverse
2123
2224import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
2325 -- the IO monad. I don't think that'd be worthwhile.
2426
2527
26−infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String T.Variable)
28+infer :: Interfaces -> MetadataModule t v -> Either [Doc] (Map.Map String Type)
2729infer interfaces modul = unsafePerformIO $ do
2830 env <- Env.initialEnvironment
2931 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))
@@ -45,8 +47,9 @@ infer interfaces modul = unsafePerformIO $ do
4547 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)
4648
4749 state <- execStateT (Solve.solve constraint) TS.initialState
48− let errors = TS.sErrors state
49− if null errors
50− then extraChecks $ Map.difference (TS.sSavedEnv state) header
51− else Left `fmap` sequence (reverse errors)
50+ 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
5255