forked from GitHub/gf-core
add ModEnv to CompileEnv. This removes the need to read one and the same time twice when multiple grammars are loaded.
This commit is contained in:
@@ -23,6 +23,10 @@ import GF.Grammar.Lookup
|
|||||||
import GF.Infra.Modules
|
import GF.Infra.Modules
|
||||||
import GF.Devel.ReadFiles
|
import GF.Devel.ReadFiles
|
||||||
|
|
||||||
|
import GF.Source.GrammarToSource
|
||||||
|
import qualified GF.Source.AbsGF as A
|
||||||
|
import qualified GF.Source.PrintGF as P
|
||||||
|
|
||||||
import GF.Data.Operations
|
import GF.Data.Operations
|
||||||
import GF.Devel.UseIO
|
import GF.Devel.UseIO
|
||||||
import GF.Devel.Arch
|
import GF.Devel.Arch
|
||||||
@@ -30,11 +34,12 @@ import GF.Devel.Arch
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
import System.Time
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
|
batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
|
||||||
batchCompile opts files = do
|
batchCompile opts files = do
|
||||||
(_,gr) <- foldM (compileModule defOpts) emptyCompileEnv files
|
(_,gr,_) <- foldM (compileModule defOpts) emptyCompileEnv files
|
||||||
return gr
|
return gr
|
||||||
where
|
where
|
||||||
defOpts = addOptions opts (options [emitCode])
|
defOpts = addOptions opts (options [emitCode])
|
||||||
@@ -50,7 +55,7 @@ prMod = compactPrint . prModule
|
|||||||
|
|
||||||
|
|
||||||
-- | the environment
|
-- | the environment
|
||||||
type CompileEnv = (Int,SourceGrammar)
|
type CompileEnv = (Int,SourceGrammar,ModEnv)
|
||||||
|
|
||||||
-- | compile with one module as starting point
|
-- | compile with one module as starting point
|
||||||
-- command-line options override options (marked by --#) in the file
|
-- command-line options override options (marked by --#) in the file
|
||||||
@@ -72,20 +77,17 @@ compileModule opts1 env file = do
|
|||||||
ps <- ioeIO $ extendPathEnv ps1
|
ps <- ioeIO $ extendPathEnv ps1
|
||||||
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
|
let ioeIOIf = if oElem beVerbose opts then ioeIO else (const (return ()))
|
||||||
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
|
ioeIOIf $ putStrLn $ "module search path:" +++ show ps ----
|
||||||
let sgr = snd env
|
let (_,sgr,rfs) = env
|
||||||
let rfs = Map.empty ---- files already in memory and their read times
|
|
||||||
let file' = if useFileOpt then takeFileName file else file -- to find file itself
|
let file' = if useFileOpt then takeFileName file else file -- to find file itself
|
||||||
files <- getAllFiles opts ps rfs file'
|
files <- getAllFiles opts ps rfs file'
|
||||||
ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
|
ioeIOIf $ putStrLn $ "files to read:" +++ show files ----
|
||||||
let names = map justModuleName files
|
let names = map justModuleName files
|
||||||
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
|
ioeIOIf $ putStrLn $ "modules to include:" +++ show names ----
|
||||||
let sgr2 = MGrammar [m | m@(i,_) <- modules sgr,
|
foldM (compileOne opts) (0,sgr,rfs) files
|
||||||
notElem (prt i) $ map dropExtension names]
|
|
||||||
foldM (compileOne opts) (0,sgr2) files
|
|
||||||
|
|
||||||
|
|
||||||
compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
|
compileOne :: Options -> CompileEnv -> FullPath -> IOE CompileEnv
|
||||||
compileOne opts env@(_,srcgr) file = do
|
compileOne opts env@(_,srcgr,_) file = do
|
||||||
|
|
||||||
let putp s = putPointE opts ("\n" ++ s)
|
let putp s = putPointE opts ("\n" ++ s)
|
||||||
let putpp = putPointEsil opts
|
let putpp = putPointEsil opts
|
||||||
@@ -107,25 +109,25 @@ compileOne opts env@(_,srcgr) file = do
|
|||||||
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
|
sm0 <- putp ("+ reading" +++ file) $ getSourceModule opts file
|
||||||
let sm1 = unsubexpModule sm0
|
let sm1 = unsubexpModule sm0
|
||||||
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
|
sm <- {- putp "creating indirections" $ -} ioeErr $ extendModule mos sm1
|
||||||
extendCompileEnv env sm
|
|
||||||
|
extendCompileEnv env file sm
|
||||||
|
|
||||||
-- for gf source, do full compilation and generate code
|
-- for gf source, do full compilation and generate code
|
||||||
_ -> do
|
_ -> do
|
||||||
|
|
||||||
let modu = dropExtension file
|
let gfo = gfoFile (dropExtension file)
|
||||||
b1 <- ioeIO $ doesFileExist file
|
b1 <- ioeIO $ doesFileExist file
|
||||||
if not b1
|
if not b1
|
||||||
then compileOne opts env $ gfoFile $ modu
|
then compileOne opts env $ gfo
|
||||||
else do
|
else do
|
||||||
|
|
||||||
sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $
|
sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $
|
||||||
getSourceModule opts file
|
getSourceModule opts file
|
||||||
(k',sm) <- compileSourceModule opts env sm0
|
(k',sm) <- compileSourceModule opts env sm0
|
||||||
let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str
|
let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str
|
||||||
cm <- putpp " generating code... " $ generateModuleCode opts path sm1
|
cm <- putpp " generating code... " $ generateModuleCode opts gfo sm1
|
||||||
-- sm is optimized before generation, but not in the env
|
-- sm is optimized before generation, but not in the env
|
||||||
let cm2 = unsubexpModule cm
|
extendCompileEnvInt env k' gfo sm1
|
||||||
extendCompileEnvInt env (k',sm1)
|
|
||||||
where
|
where
|
||||||
isConcr (_,mi) = case mi of
|
isConcr (_,mi) = case mi of
|
||||||
ModMod m -> isModCnc m && mstatus m /= MSIncomplete
|
ModMod m -> isModCnc m && mstatus m /= MSIncomplete
|
||||||
@@ -134,7 +136,7 @@ compileOne opts env@(_,srcgr) file = do
|
|||||||
|
|
||||||
compileSourceModule :: Options -> CompileEnv ->
|
compileSourceModule :: Options -> CompileEnv ->
|
||||||
SourceModule -> IOE (Int,SourceModule)
|
SourceModule -> IOE (Int,SourceModule)
|
||||||
compileSourceModule opts env@(k,gr) mo@(i,mi) = do
|
compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do
|
||||||
|
|
||||||
let putp = putPointE opts
|
let putp = putPointE opts
|
||||||
putpp = putPointEsil opts
|
putpp = putPointEsil opts
|
||||||
@@ -170,19 +172,13 @@ compileSourceModule opts env@(k,gr) mo@(i,mi) = do
|
|||||||
---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
|
---- prDebug mo = ioeIO $ putStrLn $ prGrammar $ MGrammar [mo] ---- debug
|
||||||
prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
|
prDebug mo = ioeIO $ print $ length $ lines $ prGrammar $ MGrammar [mo]
|
||||||
|
|
||||||
generateModuleCode :: Options -> InitPath -> SourceModule -> IOE SourceModule
|
generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule
|
||||||
generateModuleCode opts path minfo@(name,info) = do
|
generateModuleCode opts file minfo = do
|
||||||
|
let minfo1 = subexpModule minfo
|
||||||
let pname = path </> prt name
|
out = prGrammar (MGrammar [minfo1])
|
||||||
let minfo0 = minfo
|
|
||||||
let minfo1 = subexpModule minfo0
|
|
||||||
let minfo2 = minfo1
|
|
||||||
|
|
||||||
let (file,out) = (gfoFile pname, prGrammar (MGrammar [minfo2]))
|
|
||||||
putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
|
putp (" wrote file" +++ file) $ ioeIO $ writeFile file $ compactPrint out
|
||||||
|
return minfo1
|
||||||
return minfo2
|
where
|
||||||
where
|
|
||||||
putp = putPointE opts
|
putp = putPointE opts
|
||||||
putpp = putPointEsil opts
|
putpp = putPointEsil opts
|
||||||
|
|
||||||
@@ -195,11 +191,13 @@ pathListOpts opts file = return $ maybe [file] splitInModuleSearchPath $ getOptV
|
|||||||
reverseModules (MGrammar ms) = MGrammar $ reverse ms
|
reverseModules (MGrammar ms) = MGrammar $ reverse ms
|
||||||
|
|
||||||
emptyCompileEnv :: CompileEnv
|
emptyCompileEnv :: CompileEnv
|
||||||
emptyCompileEnv = (0,emptyMGrammar)
|
emptyCompileEnv = (0,emptyMGrammar,Map.empty)
|
||||||
|
|
||||||
extendCompileEnvInt (_,MGrammar ss) (k,sm) =
|
extendCompileEnvInt (_,MGrammar ss,menv) k file sm = do
|
||||||
return (k,MGrammar (sm:ss)) --- reverse later
|
let (mod,imps) = importsOfModule (trModule sm)
|
||||||
|
t <- ioeIO $ getModificationTime file
|
||||||
|
return (k,MGrammar (sm:ss),Map.insert mod (t,imps) menv) --- reverse later
|
||||||
|
|
||||||
extendCompileEnv e@(k,_) sm = extendCompileEnvInt e (k,sm)
|
extendCompileEnv e@(k,_,_) file sm = extendCompileEnvInt e k file sm
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -19,7 +19,7 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module GF.Devel.ReadFiles
|
module GF.Devel.ReadFiles
|
||||||
( getAllFiles,ModName,getOptionsFromFile,importsOfModule,
|
( getAllFiles,ModName,ModEnv,getOptionsFromFile,importsOfModule,
|
||||||
gfoFile,gfFile,isGFO ) where
|
gfoFile,gfFile,isGFO ) where
|
||||||
|
|
||||||
import GF.Infra.Option
|
import GF.Infra.Option
|
||||||
|
|||||||
Reference in New Issue
Block a user