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.

1 files changed, 24 insertions, 25 deletions

diff --git a/src/compiler/GF/CompileOne.hs b/src/compiler/GF/CompileOne.hs
index 5310a7ebb..0a6fcb56a 100644
--- a/src/compiler/GF/CompileOne.hs
+++ b/src/compiler/GF/CompileOne.hs
@@ -1,8 +1,7 @@
 module GF.CompileOne(OneOutput,CompiledModule,
-                     compileOne --, CompileSource, compileSourceModule
+                     compileOne,reuseGFO,useTheSource
+                     --, CompileSource, compileSourceModule
                      ) where
-import Prelude hiding (catch)
-import GF.System.Catch
 
 -- The main compiler passes
 import GF.Compile.GetGrammar(getSourceModule)
@@ -19,7 +18,7 @@ import GF.Grammar.Printer(ppModule,TermPrintQual(..))
 import GF.Grammar.Binary(decodeModule,encodeModule)
 
 import GF.Infra.Option
-import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,liftIO,ePutStrLn,putPointE,putStrE)
+import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,liftIO,Output(..),putPointE)
 import GF.Infra.CheckM(runCheck')
 import GF.Data.Operations(liftErr,(+++))
 
@@ -33,27 +32,13 @@ type CompiledModule = SourceModule
 
 -- | Compile a given source file (or just load a .gfo file),
 -- given a 'SourceGrammar' containing everything it depends on.
-compileOne :: Options -> SourceGrammar -> FullPath -> IOE OneOutput
+--compileOne :: Options -> SourceGrammar -> FullPath -> IOE OneOutput
 compileOne opts srcgr file =
     if isGFO file
     then reuseGFO opts srcgr file
     else do b1 <- doesFileExist file
-            if b1 then useTheSource
+            if b1 then useTheSource opts srcgr file
                   else reuseGFO opts srcgr (gf2gfo opts file)
-  where
-    -- | For gf source, do full compilation and generate code
-    useTheSource =
-      do sm <- putpOpt ("- parsing" +++ file)
-                       ("- compiling" +++ file ++ "... ")
-                       (getSourceModule opts file)
-         idump opts Source sm
-         cwd <- getCurrentDirectory
-         compileSourceModule opts cwd (Just file) srcgr sm
-
-    putpOpt v m act
-       | verbAtLeast opts Verbose = putPointE Normal opts v act
-       | verbAtLeast opts Normal  = putStrE m >> act
-       | otherwise                = putPointE Verbose opts v act
 
 -- | For compiled gf, read the file and update environment
 -- also undo common subexp optimization, to enable normal computations
@@ -76,9 +61,24 @@ reuseGFO opts srcgr file =
 
      return (Just file,sm)
 
+-- | For gf source, do full compilation and generate code
+--useTheSource :: Options -> SourceGrammar -> FullPath -> IOE OneOutput
+useTheSource opts srcgr file =
+      do sm <- putpOpt ("- parsing" +++ file)
+                       ("- compiling" +++ file ++ "... ")
+                       (getSourceModule opts file)
+         idump opts Source sm
+         cwd <- getCurrentDirectory
+         compileSourceModule opts cwd (Just file) srcgr sm
+  where
+    putpOpt v m act
+       | verbAtLeast opts Verbose = putPointE Normal opts v act
+       | verbAtLeast opts Normal  = putStrE m >> act
+       | otherwise                = putPointE Verbose opts v act
+
 type CompileSource = SourceGrammar -> SourceModule -> IOE OneOutput
 
-compileSourceModule :: Options -> FilePath -> Maybe FilePath -> CompileSource
+--compileSourceModule :: Options -> FilePath -> Maybe FilePath -> CompileSource
 compileSourceModule opts cwd mb_gfFile gr =
     if flag optTagsOnly opts
     then generateTags <=< ifComplete middle               <=< frontend
@@ -128,7 +128,7 @@ compileSourceModule opts cwd mb_gfFile gr =
     maybeM f = maybe (return ()) f
 
 
-writeGFO :: Options -> FilePath -> SourceModule -> IOE ()
+--writeGFO :: Options -> FilePath -> SourceModule -> IOE ()
 writeGFO opts file mo =
     putPointE Normal opts ("  write file" +++ file) $
       liftIO $ encodeModule file mo2
@@ -139,7 +139,7 @@ writeGFO opts file mo =
     notAnyInd x = case x of AnyInd{} -> False; _ -> True
 
 -- to output an intermediate stage
-intermOut :: Options -> Dump -> Doc -> IOE ()
+--intermOut :: Options -> Dump -> Doc -> IOE ()
 intermOut opts d doc
   | dump opts d = ePutStrLn (render ("\n\n--#" <+> show d $$ doc))
   | otherwise   = return ()
@@ -148,9 +148,8 @@ idump opts pass = intermOut opts (Dump pass) . ppModule Internal
 
 warnOut opts warnings
   | null warnings = return ()
-  | otherwise     = liftIO $ ePutStrLn ws `catch` oops
+  | otherwise     = do ePutStr "\ESC[34m";ePutStr ws;ePutStrLn "\ESC[m"
   where
-    oops _ = ePutStrLn "" -- prevent crash on character encoding problem
     ws = if flag optVerbosity opts == Normal
          then '\n':warnings
          else warnings