Make grammar and trees files command line arguments into benchmark script

This commit is contained in:
John J. Camilleri
2021-02-18 15:27:25 +01:00
parent e6079523f1
commit 5240749fad
2 changed files with 32 additions and 31 deletions

View File

@@ -28,12 +28,13 @@ Comparing PGF, PGF2, LPGF along following criteria:
### Running ### Running
Run each command separately so that memory measurements are isolated. Run each command separately so that memory measurements are isolated.
The `+RTS -T -RTS` is so that GHC can report its own memory usage.
``` ```
stack build --test --bench --no-run-tests --no-run-benchmarks stack build --test --bench --no-run-tests --no-run-benchmarks
stack bench --benchmark-arguments "compile pgf +RTS -T -RTS" stack bench --benchmark-arguments "compile pgf Foods*.gf +RTS -T -RTS"
stack bench --benchmark-arguments "compile lpgf +RTS -T -RTS" stack bench --benchmark-arguments "compile lpgf Foods*.gf +RTS -T -RTS"
stack bench --benchmark-arguments "run pgf +RTS -T -RTS" stack bench --benchmark-arguments "run pgf Foods.pgf foods.trees +RTS -T -RTS"
stack bench --benchmark-arguments "run pgf2 +RTS -T -RTS" stack bench --benchmark-arguments "run pgf2 Foods.pgf foods.trees +RTS -T -RTS"
stack bench --benchmark-arguments "run lpgf +RTS -T -RTS" stack bench --benchmark-arguments "run lpgf Foods.lpgf foods.trees +RTS -T -RTS"
``` ```

View File

@@ -10,50 +10,50 @@ 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) import Data.Maybe (fromJust, isJust, isNothing)
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 (getArgs) import System.Environment (getArgs)
import System.Exit (die) import System.Exit (die)
import System.FilePath ((</>), (<.>), takeBaseName, takeExtension) import System.FilePath ((</>), (<.>), takeBaseName, takeExtension, dropExtension)
import Text.Printf (printf) import Text.Printf (printf)
import GHC.Stats import GHC.Stats
dir :: FilePath
dir = "testsuite" </> "lpgf"
grammarName :: String
grammarName = "Foods"
treesFile :: String
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 :: String
usage = "Usage: ... <compile|run> [pgf|pgf2|lpgf]" usage = "Arguments:\n\
\ compile [pgf|lpgf] FoodsEng.gf FoodsGer.gf ...\n\
\ run [pgf|pgf2|lpgf] Foods.pgf test.trees\
\"
main :: IO () main :: IO ()
main = do main = do
-- Parse command line arguments
args <- getArgs args <- getArgs
when (length args < 1) (die usage) let argc = length args
when (argc < 1) (die usage)
let (mode:_) = args let (mode:_) = args
when (mode `L.notElem` ["compile","run"]) (die usage) when (mode `L.notElem` ["compile","run"]) (die usage)
let target = if length args >= 2 then args !! 1 else "" when (mode == "compile" && argc < 2) (die usage)
when (mode == "run" && argc < 3) (die usage)
let target = let a1 = args !! 1 in if a1 `elem` ["pgf", "pgf2", "lpgf"] then Just a1 else Nothing
let mods = if mode == "compile" then drop (if isJust target then 2 else 1) args else []
-- If * is supplied in module name, collect modules ourselves
-- mods <- map (dir </>)
-- . filter (\p -> grammarName `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf")
-- <$> listDirectory dir
-- Collect concrete modules let binaryFile = if mode == "run" then Just $ args !! (if isJust target then 2 else 1) else Nothing
mods <- map (dir </>) let treesFile = if mode == "run" then Just $ args !! (if isJust target then 3 else 2) else Nothing
. filter (\p -> grammarName `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf")
<$> listDirectory dir
printf "Found %d modules\n" (length mods)
let doPGF = null target || target == "pgf" let doPGF = isNothing target || target == Just "pgf"
let doPGF2 = null target || target == "pgf2" let doPGF2 = isNothing target || target == Just "pgf2"
let doLPGF = null target || target == "lpgf" let doLPGF = isNothing target || target == Just "lpgf"
-- Compilation -- Compilation
when (mode == "compile") $ do when (mode == "compile") $ do
@@ -72,26 +72,26 @@ main = do
-- Linearisation -- Linearisation
when (mode == "run") $ do when (mode == "run") $ do
-- Read trees -- Read trees
lns <- lines <$> readFile (dir </> treesFile) lns <- lines <$> readFile (fromJust 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)
when doPGF $ do when doPGF $ do
putStrLn "PGF" putStrLn "PGF"
pgf <- PGF.readPGF (grammarName <.> "pgf") -- might fail! pgf <- PGF.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
time "linearise" (return $ length $ linPGF pgf trees) time "linearise" (return $ length $ linPGF pgf trees)
return () return ()
when doPGF2 $ do when doPGF2 $ do
putStrLn "PGF2" putStrLn "PGF2"
pgf <- PGF2.readPGF (grammarName <.> "pgf") -- might fail! pgf <- PGF2.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
time "linearise" (return $ length $ linPGF2 pgf trees2) time "linearise" (return $ length $ linPGF2 pgf trees2)
return () return ()
when doLPGF $ do when doLPGF $ do
putStrLn "LPGF" putStrLn "LPGF"
lpgf <- LPGF.readLPGF (grammarName <.> "lpgf") -- might fail! lpgf <- LPGF.readLPGF (dropExtension (fromJust binaryFile) <.> "lpgf")
time "linearise" (return $ length $ linLPGF lpgf trees) time "linearise" (return $ length $ linLPGF lpgf trees)
return () return ()