Separate compile/run in benchmark

gf.cabal

@@ -701,12 +701,29 @@ benchmark lpgf-bench
     PGF.TypeCheck
     PGF.Utilities
     PGF.VisualizeTree
+    PGF2
+    PGF2.Expr
+    PGF2.Type
+    PGF2.FFI
     Paths_gf
   if flag(interrupt)
     cpp-options: -DUSE_INTERRUPT
     other-modules: GF.System.UseSignal
   else
     other-modules: GF.System.NoSignal
+
+  hs-source-dirs:
+    src/runtime/haskell-bind
+  other-modules:
+    PGF2
+    PGF2.FFI
+    PGF2.Expr
+    PGF2.Type
+  build-tools:     hsc2hs
+  extra-libraries: pgf gu
+  c-sources:       src/runtime/haskell-bind/utils.c
+  cc-options:      -std=c99
+
   build-depends:
     array,
     base>=4.6 && <5,

testsuite/lpgf/README.md

@@ -27,10 +27,13 @@ Comparing PGF, PGF2, LPGF along following criteria:
 
 ### Running
 
+Run each command separately so that memory measurements are isolated.
+
 ```
 stack build --test --bench --no-run-tests --no-run-benchmarks
-stack bench --benchmark-arguments "+RTS -T -RTS"
-ONLY=PGF stack bench --benchmark-arguments "+RTS -T -RTS"
-ONLY=PGF2 stack bench --benchmark-arguments "+RTS -T -RTS"
-ONLY=LPGF stack bench --benchmark-arguments "+RTS -T -RTS"
+stack bench --benchmark-arguments "compile pgf +RTS -T -RTS"
+stack bench --benchmark-arguments "compile lpgf +RTS -T -RTS"
+stack bench --benchmark-arguments "run pgf +RTS -T -RTS"
+stack bench --benchmark-arguments "run pgf2 +RTS -T -RTS"
+stack bench --benchmark-arguments "run lpgf +RTS -T -RTS"
 ```

testsuite/lpgf/bench.hs

@@ -10,12 +10,13 @@ import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, m
 
 import Control.Monad (when)
 import qualified Data.List as L
-import Data.Maybe (fromJust, isNothing)
+import Data.Maybe (fromJust)
 import qualified Data.Map as Map
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime, diffUTCTime)
 import System.Directory (listDirectory, getFileSize)
-import System.Environment (lookupEnv)
+import System.Environment (getArgs)
+import System.Exit (die)
 import System.FilePath ((</>), (<.>), takeBaseName, takeExtension)
 import Text.Printf (printf)
 
@@ -33,46 +34,66 @@ treesFile = "Foods-all.trees"
 options :: Options
 options = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet})) noOptions
 
+usage :: String
+usage = "Usage: ... <compile|run> [pgf|pgf2|lpgf]"
+
 main :: IO ()
 main = do
+  args <- getArgs
+  when (length args < 1) (die usage)
+  let (mode:_) = args
+  when (mode `L.notElem` ["compile","run"]) (die usage)
+  let target = if length args >= 2 then args !! 1 else ""
+
   -- Collect concrete modules
   mods <- map (dir </>)
         . filter (\p -> grammarName `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf")
         <$> listDirectory dir
   printf "Found %d modules\n" (length mods)
 
-  -- Read trees
-  lns <- lines <$> readFile (dir </> treesFile)
-  let trees = map (fromJust . PGF.readExpr) lns
-  let trees2 = map (fromJust . PGF2.readExpr) lns
-  printf "Read %d trees\n" (length trees)
+  let doPGF = null target || target == "pgf"
+  let doPGF2 = null target || target == "pgf2"
+  let doLPGF = null target || target == "lpgf"
 
-  only <- lookupEnv "ONLY"
-  let doPGF = isNothing only || only == Just "PGF"
-  let doPGF2 = isNothing only || only == Just "PGF2"
-  let doLPGF = isNothing only || only == Just "LPGF"
+  -- Compilation
+  when (mode == "compile") $ do
+    when doPGF $ do
+      putStrLn "PGF"
+      (path, pgf) <- time "compile" (compilePGF mods)
+      size <- getFileSize path
+      printf "- size: %s  %s\n" (convertSize size) path
 
-  when doPGF $ do
-    putStrLn "PGF"
-    (path, pgf) <- time "compile" (compilePGF mods)
-    size <- getFileSize path
-    printf "- size: %s\n" (convertSize size)
-    time "linearise" (return $ length $ linPGF pgf trees)
-    return ()
+    when doLPGF $ do
+      putStrLn "LPGF"
+      (path, lpgf) <- time "compile" (compileLPGF mods)
+      size <- getFileSize path
+      printf "- size: %s  %s\n" (convertSize size) path
 
-  when doPGF2 $ do
-    putStrLn "PGF2"
-    pgf <- PGF2.readPGF (grammarName <.> "pgf") -- might fail!
-    time "linearise" (return $ length $ linPGF2 pgf trees2)
-    return ()
+  -- Linearisation
+  when (mode == "run") $ do
+    -- Read trees
+    lns <- lines <$> readFile (dir </> treesFile)
+    let trees = map (fromJust . PGF.readExpr) lns
+    let trees2 = map (fromJust . PGF2.readExpr) lns
+    printf "Read %d trees\n" (length trees)
 
-  when doLPGF $ do
-    putStrLn "LPGF"
-    (path, lpgf) <- time "compile" (compileLPGF mods)
-    size <- getFileSize path
-    printf "- size: %s\n" (convertSize size)
-    time "linearise" (return $ length $ linLPGF lpgf trees)
-    return ()
+    when doPGF $ do
+      putStrLn "PGF"
+      pgf <- PGF.readPGF (grammarName <.> "pgf") -- might fail!
+      time "linearise" (return $ length $ linPGF pgf trees)
+      return ()
+
+    when doPGF2 $ do
+      putStrLn "PGF2"
+      pgf <- PGF2.readPGF (grammarName <.> "pgf") -- might fail!
+      time "linearise" (return $ length $ linPGF2 pgf trees2)
+      return ()
+
+    when doLPGF $ do
+      putStrLn "LPGF"
+      lpgf <- LPGF.readLPGF (grammarName <.> "lpgf") -- might fail!
+      time "linearise" (return $ length $ linLPGF lpgf trees)
+      return ()
 
   stats <- getRTSStats
   printf "Max live memory: %s\n" (convertSize (read (show (max_live_bytes stats))))