Separate compile/run in benchmark

This commit is contained in:
John J. Camilleri
2021-02-17 16:57:06 +01:00
parent 9a263450f5
commit 7a5bc2dab3
3 changed files with 75 additions and 34 deletions

View File

@@ -701,12 +701,29 @@ benchmark lpgf-bench
PGF.TypeCheck PGF.TypeCheck
PGF.Utilities PGF.Utilities
PGF.VisualizeTree PGF.VisualizeTree
PGF2
PGF2.Expr
PGF2.Type
PGF2.FFI
Paths_gf Paths_gf
if flag(interrupt) if flag(interrupt)
cpp-options: -DUSE_INTERRUPT cpp-options: -DUSE_INTERRUPT
other-modules: GF.System.UseSignal other-modules: GF.System.UseSignal
else else
other-modules: GF.System.NoSignal 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: build-depends:
array, array,
base>=4.6 && <5, base>=4.6 && <5,

View File

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

View File

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