mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-11 13:59:31 -06:00
Check file datestamp before creating PGF file when compiling grammars
When running a command like gf -make L_1.gf ... L_n.gf gf now avoids recreating the target PGF file if it already exists and is up-to-date. gf still reads all required .gfo files, so significant additional speed improvements are still possible. This could be done by reading .gfo files more lazily...
This commit is contained in:
@@ -46,7 +46,7 @@ importSource :: SourceGrammar -> Options -> [FilePath] -> IO SourceGrammar
|
||||
importSource src0 opts files = do
|
||||
src <- appIOE $ batchCompile opts files
|
||||
case src of
|
||||
Ok gr -> return gr
|
||||
Ok (_,_,gr) -> return gr
|
||||
Bad msg -> do
|
||||
putStrLn msg
|
||||
return src0
|
||||
@@ -58,7 +58,7 @@ importCF opts files get = do
|
||||
Ok gf -> return gf
|
||||
Bad s -> error s ----
|
||||
Ok gr <- appIOE $ compileSourceGrammar opts gf
|
||||
epgf <- appIOE $ link opts (identS (justModuleName (last files) ++ "Abs")) gr
|
||||
epgf <- appIOE $ link opts (identS (justModuleName (last files) ++ "Abs"), (), gr)
|
||||
case epgf of
|
||||
Ok pgf -> return pgf
|
||||
Bad s -> error s ----
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
module GF.Compile (batchCompile, link, compileToPGF, compileSourceGrammar) where
|
||||
module GF.Compile (batchCompile, link, srcAbsName, compileToPGF, compileSourceGrammar) where
|
||||
import Prelude hiding (catch)
|
||||
import GF.System.Catch
|
||||
|
||||
@@ -31,6 +31,7 @@ import System.FilePath
|
||||
import qualified Data.Map as Map
|
||||
--import qualified Data.Set as Set
|
||||
import Data.List(nub)
|
||||
import Data.Time(UTCTime)
|
||||
import Text.PrettyPrint
|
||||
|
||||
import PGF.Optimize
|
||||
@@ -38,33 +39,33 @@ import PGF
|
||||
|
||||
-- | Compiles a number of source files and builds a 'PGF' structure for them.
|
||||
compileToPGF :: Options -> [FilePath] -> IOE PGF
|
||||
compileToPGF opts fs =
|
||||
do gr <- batchCompile opts fs
|
||||
let name = justModuleName (last fs)
|
||||
link opts (identS name) gr
|
||||
compileToPGF opts fs = link opts =<< batchCompile opts fs
|
||||
|
||||
link :: Options -> Ident -> SourceGrammar -> IOE PGF
|
||||
link opts cnc gr = do
|
||||
let isv = (verbAtLeast opts Normal)
|
||||
link :: Options -> (Ident,t,SourceGrammar) -> IOE PGF
|
||||
link opts (cnc,_,gr) =
|
||||
putPointE Normal opts "linking ... " $ do
|
||||
let abs = err (const cnc) id $ abstractOfConcrete gr cnc
|
||||
let abs = srcAbsName gr cnc
|
||||
pgf <- mkCanon2pgf opts gr abs
|
||||
probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
|
||||
when (verbAtLeast opts Normal) $ putStrE "OK"
|
||||
return $ setProbabilities probs
|
||||
$ if flag optOptimizePGF opts then optimizePGF pgf else pgf
|
||||
|
||||
batchCompile :: Options -> [FilePath] -> IOE SourceGrammar
|
||||
srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc
|
||||
|
||||
batchCompile :: Options -> [FilePath] -> IOE (Ident,UTCTime,SourceGrammar)
|
||||
batchCompile opts files = do
|
||||
(_,gr,_) <- foldM (compileModule opts) emptyCompileEnv files
|
||||
return gr
|
||||
(_,gr,menv) <- foldM (compileModule opts) emptyCompileEnv files
|
||||
let cnc = identS (justModuleName (last files))
|
||||
t = maximum . map fst $ Map.elems menv
|
||||
return (cnc,t,gr)
|
||||
|
||||
-- to compile a set of modules, e.g. an old GF or a .cf file
|
||||
compileSourceGrammar :: Options -> SourceGrammar -> IOE SourceGrammar
|
||||
compileSourceGrammar opts gr = do
|
||||
cwd <- liftIO getCurrentDirectory
|
||||
(_,gr',_) <- foldM (\env -> compileSourceModule opts cwd env Nothing)
|
||||
(0,emptySourceGrammar,Map.empty)
|
||||
emptyCompileEnv
|
||||
(modules gr)
|
||||
return gr'
|
||||
|
||||
@@ -84,9 +85,6 @@ warnOut opts warnings
|
||||
then '\n':warnings
|
||||
else warnings
|
||||
|
||||
-- | the environment
|
||||
type CompileEnv = (Int,SourceGrammar,ModEnv)
|
||||
|
||||
-- | compile with one module as starting point
|
||||
-- command-line options override options (marked by --#) in the file
|
||||
-- As for path: if it is read from file, the file path is prepended to each name.
|
||||
@@ -238,6 +236,9 @@ writeGFO opts file mo = do
|
||||
|
||||
--reverseModules (MGrammar ms) = MGrammar $ reverse ms
|
||||
|
||||
-- | The environment
|
||||
type CompileEnv = (Int,SourceGrammar,ModEnv)
|
||||
|
||||
emptyCompileEnv :: CompileEnv
|
||||
emptyCompileEnv = (0,emptySourceGrammar,Map.empty)
|
||||
|
||||
|
||||
@@ -10,7 +10,7 @@ import GF.Compile
|
||||
import GF.Compile.Export
|
||||
|
||||
import GF.Grammar.CF ---- should this be on a deeper level? AR 15/10/2008
|
||||
import GF.Infra.Ident(identS)
|
||||
import GF.Infra.Ident(identS,showIdent)
|
||||
|
||||
import GF.Infra.UseIO
|
||||
import GF.Infra.Option
|
||||
@@ -45,13 +45,19 @@ mainGFC opts fs = do
|
||||
|
||||
compileSourceFiles :: Options -> [FilePath] -> IOE ()
|
||||
compileSourceFiles opts fs =
|
||||
do gr <- batchCompile opts fs
|
||||
let cnc = justModuleName (last fs)
|
||||
do cnc_gr@(cnc,t_src,gr) <- batchCompile opts fs
|
||||
unless (flag optStopAfterPhase opts == Compile) $
|
||||
do pgf <- link opts (identS cnc) gr
|
||||
writePGF opts pgf
|
||||
writeByteCode opts pgf
|
||||
writeOutputs opts pgf
|
||||
do let abs = showIdent (srcAbsName gr cnc)
|
||||
pgfFile = grammarName' opts abs<.>"pgf"
|
||||
t_pgf <- if outputJustPGF opts
|
||||
then maybeIO $ getModificationTime pgfFile
|
||||
else return Nothing
|
||||
if t_pgf >= Just t_src
|
||||
then putIfVerb opts $ pgfFile ++ " is up-to-date."
|
||||
else do pgf <- link opts cnc_gr
|
||||
writePGF opts pgf
|
||||
writeByteCode opts pgf
|
||||
writeOutputs opts pgf
|
||||
|
||||
compileCFFiles :: Options -> [FilePath] -> IOE ()
|
||||
compileCFFiles opts fs =
|
||||
@@ -59,13 +65,13 @@ compileCFFiles opts fs =
|
||||
let cnc = justModuleName (last fs)
|
||||
gr <- compileSourceGrammar opts =<< getCF cnc s
|
||||
unless (flag optStopAfterPhase opts == Compile) $
|
||||
do pgf <- link opts (identS cnc) gr
|
||||
do pgf <- link opts (identS cnc, (), gr)
|
||||
writePGF opts pgf
|
||||
writeOutputs opts pgf
|
||||
|
||||
unionPGFFiles :: Options -> [FilePath] -> IOE ()
|
||||
unionPGFFiles opts fs =
|
||||
if null (outputFormats opts)
|
||||
if outputJustPGF opts
|
||||
then maybe doIt checkFirst (flag optName opts)
|
||||
else doIt
|
||||
where
|
||||
@@ -97,6 +103,7 @@ writeOutputs opts pgf = do
|
||||
(name,str) <- exportPGF opts fmt pgf]
|
||||
|
||||
outputFormats opts = [fmt | fmt <- flag optOutputFormats opts, fmt/=FmtByteCode]
|
||||
outputJustPGF opts = null (flag optOutputFormats opts) && not (flag optSplitPGF opts)
|
||||
|
||||
writeByteCode :: Options -> PGF -> IOE ()
|
||||
writeByteCode opts pgf
|
||||
@@ -132,7 +139,9 @@ writePGF opts pgf
|
||||
putPointE Normal opts ("Writing " ++ outfile ++ "...") $ liftIO $ encodeFile outfile pgf
|
||||
|
||||
grammarName :: Options -> PGF -> String
|
||||
grammarName opts pgf = fromMaybe (showCId (absname pgf)) (flag optName opts)
|
||||
grammarName opts pgf = --fromMaybe (showCId (absname pgf)) (flag optName opts)
|
||||
grammarName' opts (showCId (absname pgf))
|
||||
grammarName' opts abs = fromMaybe abs (flag optName opts)
|
||||
|
||||
writeOutput :: Options -> FilePath-> String -> IOE ()
|
||||
writeOutput opts file str =
|
||||
|
||||
Reference in New Issue
Block a user