576bc28 · elk · git.iko.soy

git.iko.soy/elk

Print types even when the elm file has already been compiled.

This fixes issue #299, where types are not printed even when the `--print-types` option is given for an elm file that has already been compiled.

commit576bc281426413b2d4cf336910d899657acbf29f authorJustin Leitgeb <justin@stackbuilders.com> dateMon 28 Oct 2013, 16:29 (13 years ago) parent464c4e8

5 files changed+57−19

compare with master

unifiedsplit

compiler/Compiler.hs+21−8 compiler/SourceSyntax/Module.hs+21−1 compiler/Transform/Canonicalize.hs+1 compiler/Type/Alias.hs+13−9 compiler/Type/Inference.hs+1−1

compiler/Compiler.hs+21−8

@@ -107,6 +107,14 @@ buildFile flags moduleNum numModules interfaces filePath =

107107 bits <- L.hGetContents handle

108108 let info :: (String, ModuleInterface)

109109 info = Binary.decode bits

110+ modInterface = snd info

111+

112+ when (print_types flags)

113+ (printTypes interfaces

114+ (iTypes modInterface)

115+ (iAliases modInterface)

116+ (iImports modInterface))

117+

110118 L.length bits `seq` hClose handle

111119 return info

112120 where

@@ -145,14 +153,19 @@ buildFile flags moduleNum numModules interfaces filePath =

145153 False -> return ()

146154 True -> print . pretty $ program modul

147155 return modul

148−

149− when (print_types flags) (printTypes interfaces metaModule)

156+

157+ when (print_types flags)

158+ (printTypes interfaces

159+ (types metaModule) (aliases metaModule) (imports metaModule))

160+

150161 let interface = Canonical.interface name $ ModuleInterface {

151− iTypes = types metaModule,

152− iAdts = datatypes metaModule,

153− iAliases = aliases metaModule,

162+ iTypes = types metaModule,

163+ iImports = imports metaModule,

164+ iAdts = datatypes metaModule,

165+ iAliases = aliases metaModule,

154166 iFixities = fixities metaModule

155167 }

168+

156169 createDirectoryIfMissing True . dropFileName $ elmi flags filePath

157170 handle <- openBinaryFile (elmi flags filePath) WriteMode

158171 L.hPut handle (Binary.encode (name,interface))

@@ -160,10 +173,10 @@ buildFile flags moduleNum numModules interfaces filePath =

160173 writeFile (elmo flags filePath) (jsModule metaModule)

161174 return (name,interface)

162175

163−printTypes interfaces metaModule = do

176+printTypes interfaces moduleTypes moduleAliases moduleImports = do

164177 putStrLn ""

165− let rules = Alias.rules interfaces metaModule

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

178+ let rules = Alias.rules interfaces moduleAliases moduleImports

179+ forM_ (Map.toList moduleTypes) $ \(n,t) -> do

167180 print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)

168181 putStrLn ""

169182

compiler/SourceSyntax/Module.hs+21−1

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

1212import SourceSyntax.Declaration

1313import SourceSyntax.Type

1414import System.FilePath (joinPath)

15+import Control.Monad (liftM)

1516

1617data Module tipe var =

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

@@ -23,6 +24,22 @@ type Imports = [(String, ImportMethod)]

2324data ImportMethod = As String | Importing [String] | Hiding [String]

2425 deriving (Eq, Ord, Show, Data, Typeable)

2526

27+instance Binary ImportMethod where

28+ put (As s) = do put (0 :: Word8)

29+ put s

30+

31+ put (Importing ss) = do put (1 :: Word8)

32+ put ss

33+

34+ put (Hiding ss) = do put (2 :: Word8)

35+ put ss

36+

37+ get = do tag <- getWord8

38+ case tag of

39+ 0 -> liftM As get

40+ 1 -> liftM Importing get

41+ 2 -> liftM Hiding get

42+

2643data MetadataModule t v = MetadataModule {

2744 names :: [String],

2845 path :: FilePath,

@@ -42,15 +59,18 @@ type ADT = (String, [String], [(String,[Type])])

4259

4360data ModuleInterface = ModuleInterface {

4461 iTypes :: Map.Map String Type,

62+ iImports :: [(String, ImportMethod)],

4563 iAdts :: [ADT],

4664 iAliases :: [(String, [String], Type)],

4765 iFixities :: [(Assoc, Int, String)]

4866} deriving Show

4967

68+

5069instance Binary ModuleInterface where

51− get = ModuleInterface <$> get <*> get <*> get <*> get

70+ get = ModuleInterface <$> get <*> get <*> get <*> get <*> get

5271 put modul = do

5372 put (iTypes modul)

73+ put (iImports modul)

5474 put (iAdts modul)

5575 put (iAliases modul)

5676 put (iFixities modul)

compiler/Transform/Canonicalize.hs+1

@@ -20,6 +20,7 @@ interface :: String -> ModuleInterface -> ModuleInterface

2020interface moduleName iface =

2121 ModuleInterface

2222 { iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface))

23+ , iImports = iImports iface

2324 , iAdts = map (both prefix renameCtors) (iAdts iface)

2425 , iAliases = map (both prefix renameType') (iAliases iface)

2526 , iFixities = iFixities iface -- cannot have canonicalized operators while parsing

compiler/Type/Alias.hs+13−9

@@ -11,20 +11,23 @@ import SourceSyntax.Module

1111

1212type Rules = ([(String,[String],Type)], Type -> Type)

1313

14−rules interfaces metaModule = (collect interfaces metaModule, localizer metaModule)

14+rules interfaces moduleAliases moduleImports =

15+ (collect interfaces moduleAliases, localizer moduleImports)

1516

16−collect interfaces metaModule = filter (not . isPrimitive) rawAliases

17− where

18− rawAliases = aliases metaModule ++ concatMap iAliases (Map.elems interfaces)

17+collect interfaces moduleAliases =

18+ filter (not . isPrimitive) rawAliases

19+ where

20+ rawAliases =

21+ moduleAliases ++ concatMap iAliases (Map.elems interfaces)

1922

20− isPrimitive (_,_,tipe) =

21− case tipe of

23+ isPrimitive (_,_,tipe) =

24+ case tipe of

2225 Data _ [] -> True

2326 _ -> False

2427

25−localizer metaModule = go

28+localizer moduleImports = go

2629 where

27− go tipe =

30+ go tipe =

2831 case tipe of

2932 Var _ -> tipe

3033 EmptyRecord -> tipe

@@ -32,7 +35,8 @@ localizer metaModule = go

3235 Data name ts -> Data (localize name) (map go ts)

3336 Record fs ext -> Record (map (second go) fs) (go ext)

3437

35− byMethod = foldr (\(n,m) d -> Map.insertWith (++) n [m] d) Map.empty (imports metaModule)

38+ byMethod = foldr (\(n,m) d -> Map.insertWith (++) n [m] d)

39+ Map.empty moduleImports

3640

3741 separate name =

3842 case List.elemIndices '.' name of

compiler/Type/Inference.hs+1−1

@@ -52,7 +52,7 @@ infer interfaces modul = unsafePerformIO $ do

5252 Left err -> return $ Left err

5353 Right (header, constraint) -> do

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

55− let rules = Alias.rules interfaces modul

55+ let rules = Alias.rules interfaces (aliases modul) (imports modul)

5656 case TS.sErrors state of

5757 errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))

5858 [] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)