git.iko.soy/elk
on master help sign in
Update for new Module AST
aa7c2fdEvan Czaplicki
compiler/Build/File.hs+13−14
compare with master
unifiedsplit
@@ -23,8 +23,7 @@ import qualified Build.Source as Source
23import qualified Build.Utils as Utils
23import qualified Build.Utils as Utils
24import qualified Generate.JavaScript as JS
24import qualified Generate.JavaScript as JS
25import qualified Parse.Module as Parser
25import qualified Parse.Module as Parser
26−import qualified AST.Module as M
26+import qualified AST.Module as Module
27−import qualified Transform.Canonicalize as Canonical
28
27
29-- Reader: Runtime flags, always accessible
28-- Reader: Runtime flags, always accessible
30-- Writer: Remember the last module to be accessed
29-- Writer: Remember the last module to be accessed
@@ -33,10 +32,10 @@ type BuildT m a = RWST Flag.Flags (Last String) BInterfaces m a
33type Build a = BuildT IO a
32type Build a = BuildT IO a
34
33
35-- Interfaces, remembering if something was recompiled
34-- Interfaces, remembering if something was recompiled
36−type BInterfaces = Map.Map String (Bool, M.ModuleInterface)
35+type BInterfaces = Map.Map String (Bool, Module.Interface)
37
36
38−evalBuild :: Flag.Flags -> M.Interfaces -> Build ()
37+evalBuild :: Flag.Flags -> Module.Interfaces -> Build ()
39− -> IO (Map.Map String M.ModuleInterface, Maybe String)
38+ -> IO (Map.Map String Module.Interface, Maybe String)
40evalBuild flags interfaces build =
39evalBuild flags interfaces build =
41 do (ifaces, moduleNames) <- execRWST build flags (fmap notUpdated interfaces)
40 do (ifaces, moduleNames) <- execRWST build flags (fmap notUpdated interfaces)
42 return (fmap snd ifaces, getLast moduleNames)
41 return (fmap snd ifaces, getLast moduleNames)
@@ -45,7 +44,7 @@ evalBuild flags interfaces build =
45
44
46-- | Builds a list of files, returning the moduleName of the last one.
45-- | Builds a list of files, returning the moduleName of the last one.
47-- Returns \"\" if the list is empty
46-- Returns \"\" if the list is empty
48−build :: Flag.Flags -> M.Interfaces -> [FilePath] -> IO String
47+build :: Flag.Flags -> Module.Interfaces -> [FilePath] -> IO String
49build flags interfaces files =
48build flags interfaces files =
50 do (ifaces, topName) <- evalBuild flags interfaces (buildAll files)
49 do (ifaces, topName) <- evalBuild flags interfaces (buildAll files)
51 let removeTopName = Maybe.maybe id Map.delete topName
50 let removeTopName = Maybe.maybe id Map.delete topName
@@ -56,7 +55,7 @@ build flags interfaces files =
56 | null ports = return ()
55 | null ports = return ()
57 | otherwise = Print.failure msg
56 | otherwise = Print.failure msg
58 where
57 where
59− ports = M.iPorts iface
58+ ports = Module.iPorts iface
60 msg = concat
59 msg = concat
61 [ "Port Error: ports may only appear in the main module, but\n"
60 [ "Port Error: ports may only appear in the main module, but\n"
62 , " sub-module ", name, " declares the following port"
61 , " sub-module ", name, " declares the following port"
@@ -142,16 +141,16 @@ compile number filePath =
142 createDirectoryIfMissing True (Flag.cache_dir flags)
141 createDirectoryIfMissing True (Flag.cache_dir flags)
143 createDirectoryIfMissing True (Flag.build_dir flags)
142 createDirectoryIfMissing True (Flag.build_dir flags)
144
143
145− metaModule <-
144+ canonicalModule <-
146 liftIO $ case Source.build (Flag.no_prelude flags) interfaces source of
145 liftIO $ case Source.build (Flag.no_prelude flags) interfaces source of
147 Right modul -> return modul
146 Right modul -> return modul
148 Left errors -> do Print.errors errors
147 Left errors -> do Print.errors errors
149 exitFailure
148 exitFailure
150
149
151− liftIO $ when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule
150+ liftIO $ when (Flag.print_types flags) $ Print.moduleTypes interfaces canonicalModule
152
151
153− let newInters = Canonical.interface name $ M.metaToInterface metaModule
152+ let newInters = Module.toInterface canonicalModule
154− generateCache name newInters metaModule
153+ generateCache name newInters canonicalModule
155 update name newInters True
154 update name newInters True
156
155
157 where
156 where
@@ -164,15 +163,15 @@ compile number filePath =
164 , replicate (max 1 (20 - length name)) ' '
163 , replicate (max 1 (20 - length name)) ' '
165 , "( " ++ filePath ++ " )" ]
164 , "( " ++ filePath ++ " )" ]
166
165
167− generateCache name interfs metaModule = do
166+ generateCache name interfs canonicalModule = do
168 flags <- ask
167 flags <- ask
169 liftIO $ do
168 liftIO $ do
170 createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
169 createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
171− writeFile (Utils.elmo flags filePath) (JS.generate metaModule)
170+ writeFile (Utils.elmo flags filePath) (JS.generate canonicalModule)
172 withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
171 withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
173 L.hPut handle (Binary.encode (name, interfs))
172 L.hPut handle (Binary.encode (name, interfs))
174
173
175−update :: String -> M.ModuleInterface -> Bool -> Build ()
174+update :: String -> Module.Interface -> Bool -> Build ()
176update name inter wasUpdated =
175update name inter wasUpdated =
177 do modify (Map.insert name (wasUpdated, inter))
176 do modify (Map.insert name (wasUpdated, inter))
178 tell (Last . Just $ name)
177 tell (Last . Just $ name)