mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-28 22:12:51 -06:00
Experimental: parallel batch compilation of grammars
On my laptop these changes speed up the full build of the RGL and example grammars with 'cabal build' from ~95s to ~43s and the zero build from ~18s to ~5s. The main change is the introduction of the module GF.CompileInParallel that replaces GF.Compile and the function GF.Compile.ReadFiles.getAllFiles. At present, it is activated with the new -j flag, and it is only used when combined with --make or --batch. In addition, to get parallel computations, you need to add GHC run-time flags, e.g., +RTS -N -A20M -RTS, to the command line. The Setup.hs script has been modified to pass the appropriate flags to GF for parallel compilation when compiling the RGL and example grammars, but you need a recent version of Cabal for this to work (probably >=1.20). Some additonal refactoring were made during this work. A new monad is used to avoid warnings/error messages from different modules to be intertwined when compiling in parallel, so some functios that were hardiwred to the IO or IOE monads have been lifted to work in arbitrary monads that are instances in the appropriate classes.
This commit is contained in:
@@ -25,29 +25,29 @@ import GF.Grammar.Parser
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Grammar.CFG
|
||||
import GF.Grammar.EBNF
|
||||
import GF.Compile.ReadFiles(parseSource,lift)
|
||||
import GF.Compile.ReadFiles(parseSource)
|
||||
|
||||
import qualified Data.ByteString.Char8 as BS
|
||||
import Data.Char(isAscii)
|
||||
import Control.Monad (foldM,when,unless)
|
||||
import System.Process (system)
|
||||
import System.Directory(removeFile,getCurrentDirectory)
|
||||
import GF.System.Directory(removeFile,getCurrentDirectory)
|
||||
import System.FilePath(makeRelative)
|
||||
|
||||
getSourceModule :: Options -> FilePath -> IOE SourceModule
|
||||
--getSourceModule :: Options -> FilePath -> IOE SourceModule
|
||||
getSourceModule opts file0 =
|
||||
--errIn file0 $
|
||||
do tmp <- lift $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
|
||||
raw <- lift $ keepTemp tmp
|
||||
do tmp <- liftIO $ foldM runPreprocessor (Source file0) (flag optPreprocessors opts)
|
||||
raw <- liftIO $ keepTemp tmp
|
||||
--ePutStrLn $ "1 "++file0
|
||||
(optCoding,parsed) <- parseSource opts pModDef raw
|
||||
case parsed of
|
||||
Left (Pn l c,msg) -> do file <- lift $ writeTemp tmp
|
||||
cwd <- lift $ getCurrentDirectory
|
||||
Left (Pn l c,msg) -> do file <- liftIO $ writeTemp tmp
|
||||
cwd <- getCurrentDirectory
|
||||
let location = makeRelative cwd file++":"++show l++":"++show c
|
||||
raise (location++":\n "++msg)
|
||||
Right (i,mi0) ->
|
||||
do lift $ removeTemp tmp
|
||||
do liftIO $ removeTemp tmp
|
||||
let mi =mi0 {mflags=mflags mi0 `addOptions` opts, msrc=file0}
|
||||
optCoding' = renameEncoding `fmap` flag optEncoding (mflags mi0)
|
||||
case (optCoding,optCoding') of
|
||||
@@ -59,7 +59,7 @@ getSourceModule opts file0 =
|
||||
raise $ "Encoding mismatch: "++coding++" /= "++coding'
|
||||
where coding = maybe defaultEncoding renameEncoding optCoding
|
||||
_ -> return ()
|
||||
--lift $ transcodeModule' (i,mi) -- old lexer
|
||||
--liftIO $ transcodeModule' (i,mi) -- old lexer
|
||||
return (i,mi) -- new lexer
|
||||
|
||||
getCFRules :: Options -> FilePath -> IOE [CFRule]
|
||||
@@ -67,7 +67,7 @@ getCFRules opts fpath = do
|
||||
raw <- liftIO (BS.readFile fpath)
|
||||
(optCoding,parsed) <- parseSource opts pCFRules raw
|
||||
case parsed of
|
||||
Left (Pn l c,msg) -> do cwd <- lift $ getCurrentDirectory
|
||||
Left (Pn l c,msg) -> do cwd <- getCurrentDirectory
|
||||
let location = makeRelative cwd fpath++":"++show l++":"++show c
|
||||
raise (location++":\n "++msg)
|
||||
Right rules -> return rules
|
||||
@@ -77,7 +77,7 @@ getEBNFRules opts fpath = do
|
||||
raw <- liftIO (BS.readFile fpath)
|
||||
(optCoding,parsed) <- parseSource opts pEBNFRules raw
|
||||
case parsed of
|
||||
Left (Pn l c,msg) -> do cwd <- lift $ getCurrentDirectory
|
||||
Left (Pn l c,msg) -> do cwd <- getCurrentDirectory
|
||||
let location = makeRelative cwd fpath++":"++show l++":"++show c
|
||||
raise (location++":\n "++msg)
|
||||
Right rules -> return rules
|
||||
|
||||
Reference in New Issue
Block a user