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,46 +34,66 @@ 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)
-- Read trees let doPGF = null target || target == "pgf"
lns <- lines <$> readFile (dir </> treesFile) let doPGF2 = null target || target == "pgf2"
let trees = map (fromJust . PGF.readExpr) lns let doLPGF = null target || target == "lpgf"
let trees2 = map (fromJust . PGF2.readExpr) lns
printf "Read %d trees\n" (length trees)
only <- lookupEnv "ONLY" -- Compilation
let doPGF = isNothing only || only == Just "PGF" when (mode == "compile") $ do
let doPGF2 = isNothing only || only == Just "PGF2" when doPGF $ do
let doLPGF = isNothing only || only == Just "LPGF" putStrLn "PGF"
(path, pgf) <- time "compile" (compilePGF mods)
size <- getFileSize path
printf "- size: %s %s\n" (convertSize size) path
when doPGF $ do when doLPGF $ do
putStrLn "PGF" putStrLn "LPGF"
(path, pgf) <- time "compile" (compilePGF mods) (path, lpgf) <- time "compile" (compileLPGF mods)
size <- getFileSize path size <- getFileSize path
printf "- size: %s\n" (convertSize size) printf "- size: %s %s\n" (convertSize size) path
time "linearise" (return $ length $ linPGF pgf trees)
return ()
when doPGF2 $ do -- Linearisation
putStrLn "PGF2" when (mode == "run") $ do
pgf <- PGF2.readPGF (grammarName <.> "pgf") -- might fail! -- Read trees
time "linearise" (return $ length $ linPGF2 pgf trees2) lns <- lines <$> readFile (dir </> treesFile)
return () let trees = map (fromJust . PGF.readExpr) lns
let trees2 = map (fromJust . PGF2.readExpr) lns
printf "Read %d trees\n" (length trees)
when doLPGF $ do when doPGF $ do
putStrLn "LPGF" putStrLn "PGF"
(path, lpgf) <- time "compile" (compileLPGF mods) pgf <- PGF.readPGF (grammarName <.> "pgf") -- might fail!
size <- getFileSize path time "linearise" (return $ length $ linPGF pgf trees)
printf "- size: %s\n" (convertSize size) return ()
time "linearise" (return $ length $ linLPGF lpgf 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 stats <- getRTSStats
printf "Max live memory: %s\n" (convertSize (read (show (max_live_bytes stats)))) printf "Max live memory: %s\n" (convertSize (read (show (max_live_bytes stats))))