7093436 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Switch to SrcTypes after type inference, not in compiler

7093436Evan Czaplicki13 years ago

compiler/Compiler.hs+2−5

compare with master

unifiedsplit

@@ -31,7 +31,6 @@ import Paths_Elm

31import SourceSyntax.PrettyPrint (pretty, variable)

32import Text.PrettyPrint as P

33import qualified Type.Type as Type

34−import qualified Data.Traversable as Traverse

36data Flags =

35data Flags =

37 Flags { make :: Bool

36 Flags { make :: Bool

@@ -147,9 +146,8 @@ buildFile flags moduleNum numModules interfaces filePath =

147 return modul

146 return modul

148

147

149 if print_types flags then printTypes metaModule else return ()

148 if print_types flags then printTypes metaModule else return ()

150− tipes <- Traverse.traverse Type.toSrcType (types metaModule)

151 let interface = Canonical.interface name $ ModuleInterface {

149 let interface = Canonical.interface name $ ModuleInterface {

152− iTypes = tipes,

150+ iTypes = types metaModule,

153 iAdts = datatypes metaModule,

151 iAdts = datatypes metaModule,

154 iAliases = aliases metaModule

152 iAliases = aliases metaModule

155 }

153 }

@@ -163,8 +161,7 @@ buildFile flags moduleNum numModules interfaces filePath =

163printTypes metaModule = do

161printTypes metaModule = do

164 putStrLn ""

162 putStrLn ""

165 forM_ (Map.toList $ types metaModule) $ \(n,t) -> do

163 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

168 putStrLn ""

165 putStrLn ""

169

166

170getRuntime :: Flags -> IO FilePath

167getRuntime :: Flags -> IO FilePath

compiler/SourceSyntax/Module.hs+1−2

@@ -12,7 +12,6 @@ import SourceSyntax.Expression (LExpr)

12import SourceSyntax.Declaration

13import SourceSyntax.Type

14import System.FilePath (joinPath)

15−import qualified Type.Type as Type

17data Module tipe var =

16data Module tipe var =

18 Module [String] Exports Imports [Declaration tipe var]

17 Module [String] Exports Imports [Declaration tipe var]

@@ -30,7 +29,7 @@ data MetadataModule t v = MetadataModule {

30 exports :: [String],

29 exports :: [String],

31 imports :: [(String, ImportMethod)],

30 imports :: [(String, ImportMethod)],

32 program :: LExpr t v,

31 program :: LExpr t v,

33− types :: Map.Map String Type.Variable,

32+ types :: Map.Map String Type,

34 fixities :: [(Assoc, Int, String)],

33 fixities :: [(Assoc, Int, String)],

35 aliases :: [(String, [String], Type)],

34 aliases :: [(String, [String], Type)],

36 datatypes :: [ (String, [String], [(String,[Type])]) ],

35 datatypes :: [ (String, [String], [(String,[Type])]) ],

compiler/Type/Inference.hs+8−5

@@ -12,18 +12,20 @@ import SourceSyntax.Module as Module

12import qualified SourceSyntax.Expression as Expr

13import SourceSyntax.Location (Located, noneNoDocs)

14import SourceSyntax.PrettyPrint

15+import SourceSyntax.Type (Type)

15import Text.PrettyPrint

16import Text.PrettyPrint

16import qualified Type.State as TS

17import qualified Type.State as TS

17import Type.ExtraChecks (extraChecks)

18import Type.ExtraChecks (extraChecks)

18import Control.Monad.State

19import Control.Monad.State

19import Control.Arrow (second)

20import Control.Arrow (second)

20import Transform.SortDefinitions as Sort

21import Transform.SortDefinitions as Sort

22+import qualified Data.Traversable as Traverse

22import System.IO.Unsafe -- Possible to switch over to the ST monad instead of

24import System.IO.Unsafe -- Possible to switch over to the ST monad instead of

23 -- the IO monad. I don't think that'd be worthwhile.

25 -- the IO monad. I don't think that'd be worthwhile.

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)

27infer interfaces modul = unsafePerformIO $ do

29infer interfaces modul = unsafePerformIO $ do

28 env <- Env.initialEnvironment

30 env <- Env.initialEnvironment

29 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))

31 (datatypes modul ++ concatMap iAdts (Map.elems interfaces))

@@ -45,8 +47,9 @@ infer interfaces modul = unsafePerformIO $ do

45 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)

47 constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)

47 state <- execStateT (Solve.solve constraint) TS.initialState

49 state <- execStateT (Solve.solve constraint) TS.initialState

48− let errors = TS.sErrors state

50+ case TS.sErrors state of

49− if null errors

51+ errors@(_:_) -> Left `fmap` sequence (reverse errors)

50− then extraChecks $ Map.difference (TS.sSavedEnv state) header

52+ [] -> let types = Map.difference (TS.sSavedEnv state) header in

51− else Left `fmap` sequence (reverse errors)

53+ do srcTypes <- Traverse.traverse T.toSrcType types

54+ return $ Right srcTypes