From ed3d30e3d1134dfd06ae2a88b51767041eda6c0b Mon Sep 17 00:00:00 2001 From: hallgren Date: Thu, 9 Jan 2014 17:30:24 +0000 Subject: [PATCH] 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... --- src/compiler/GF/Command/Importing.hs | 4 ++-- src/compiler/GF/Compile.hs | 33 ++++++++++++++-------------- src/compiler/GFC.hs | 29 +++++++++++++++--------- 3 files changed, 38 insertions(+), 28 deletions(-) diff --git a/src/compiler/GF/Command/Importing.hs b/src/compiler/GF/Command/Importing.hs index 4697e8b64..2bdc091f8 100644 --- a/src/compiler/GF/Command/Importing.hs +++ b/src/compiler/GF/Command/Importing.hs @@ -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 ---- diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs index b74fd340c..962a63815 100644 --- a/src/compiler/GF/Compile.hs +++ b/src/compiler/GF/Compile.hs @@ -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) diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs index 65650d922..6e4c50258 100644 --- a/src/compiler/GFC.hs +++ b/src/compiler/GFC.hs @@ -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 =