From d84c5ef1715c3e4aed4098ee9c847e2dcc86cba4 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Mon, 25 Aug 2014 09:56:00 +0000
Subject: 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.
---
 WebSetup.hs | 59 +++++++++++++++++++++++++++++++++++++----------------------
 1 file changed, 37 insertions(+), 22 deletions(-)

(limited to 'WebSetup.hs')

diff --git a/WebSetup.hs b/WebSetup.hs
index b3007e3c7..80f5fe454 100644
--- a/WebSetup.hs
+++ b/WebSetup.hs
@@ -1,11 +1,12 @@
-module WebSetup(buildWeb,installWeb,copyWeb) where
+module WebSetup(buildWeb,installWeb,copyWeb,numJobs,execute) where
 
-import System.Directory(createDirectoryIfMissing,copyFile,removeFile)
-import System.FilePath((</>))
-import System.Cmd(system)
+import System.Directory(createDirectoryIfMissing,copyFile)
+import System.FilePath((</>),dropExtension)
+import System.Process(rawSystem)
 import System.Exit(ExitCode(..))
-import Distribution.Simple.Setup(Flag(..),CopyDest(..),copyDest)
+import Distribution.Simple.Setup(BuildFlags(..),Flag(..),CopyDest(..),copyDest)
 import Distribution.Simple.LocalBuildInfo(datadir,buildDir,absoluteInstallDirs)
+import Distribution.Simple.Utils(die)
 
 {-
    To test the GF web services, the minibar and the grammar editor, use
@@ -33,7 +34,8 @@ example_grammars =  -- :: [(pgf, subdir, src)]
     letterSrc = ["Letter"++lang++".gf"|lang<-letterLangs]
     letterLangs = words "Eng Fin Fre Heb Rus Swe"
 
-buildWeb gf (pkg,lbi) =
+
+buildWeb gf (flags,pkg,lbi) =
     do --putStrLn "buildWeb"
        mapM_ build_pgf example_grammars
   where
@@ -42,26 +44,26 @@ buildWeb gf (pkg,lbi) =
     build_pgf (pgf,subdir,src) =
       do createDirectoryIfMissing True tmp_dir
          putStrLn $ "Building "++pgf
-         execute cmd
+         execute gf args
       where
         tmp_dir = gfo_dir</>subdir
         dir = "examples"</>subdir
-        cmd = gf++" -make -s -optimize-pgf --gfo-dir="++tmp_dir++
-              " --gf-lib-path="++buildDir lbi </> "rgl"++
-              " --output-dir="++gfo_dir++
-              " "++unwords [dir</>file|file<-src]
+        args = numJobs flags++["-make","-s","-optimize-pgf"]
+               ++["--gfo-dir="++tmp_dir,
+                  "--gf-lib-path="++buildDir lbi </> "rgl",
+                  "--name="++dropExtension pgf,
+                  "--output-dir="++gfo_dir]
+               ++[dir</>file|file<-src]
 
-installWeb gf args flags = setupWeb gf args dest
-  where
-    dest = NoCopyDest
+installWeb = setupWeb NoCopyDest
 
-copyWeb gf args flags = setupWeb gf args dest
+copyWeb flags = setupWeb dest
   where
     dest = case copyDest flags of
              NoFlag -> NoCopyDest
              Flag d -> d
 
-setupWeb gf args dest (pkg,lbi) =
+setupWeb dest (pkg,lbi) =
     do mapM_ (createDirectoryIfMissing True) [grammars_dir,cloud_dir]
        mapM_ copy_pgf example_grammars
        copyGFLogo
@@ -83,10 +85,23 @@ setupWeb gf args dest (pkg,lbi) =
       do createDirectoryIfMissing True logo_dir
          copyFile ("doc"</>"Logos"</>gf_logo) (logo_dir</>gf_logo)
 
-execute command =
-  do --putStrLn command
-     e <- system command
+execute command args =
+  do let cmdline = command ++ " " ++ unwords (map showArg args)
+--   putStrLn $ "Running: " ++ cmdline
+--   appendFile "running" (cmdline++"\n")
+     e <- rawSystem command args
      case e of
-       ExitSuccess -> return ()
-       _ -> fail "Command failed"
-     return ()
+       ExitSuccess   -> return ()
+       ExitFailure i -> do putStrLn $ "Ran: " ++ cmdline
+                           die $ command++" exited with exit code: " ++ show i
+  where
+    showArg arg = if ' ' `elem` arg then "'" ++ arg ++ "'" else arg
+
+numJobs flags =
+    if null n
+    then []
+    else ["-j=8"++n,"+RTS","-A20M","-N"++n,"-RTS"]
+  where
+    n = case buildNumJobs flags of
+          Flag mn | mn/=Just 1-> maybe "" show mn
+          _ -> ""
-- 
cgit v1.2.3