GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-22 09:32:53 -06:00
Code Issues Packages Projects Releases Wiki Activity

Add support for wildcards when specifying modules names in benchmark compilation

Browse Source
This commit is contained in:
John J. Camilleri
2021-02-18 21:34:23 +01:00
parent 625386a14f
commit 51e543878b
2 changed files with 23 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
testsuite/lpgf/README.md
View File

@@ -32,9 +32,9 @@ 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 Foods*.gf +RTS -T -RTS" stack bench --benchmark-arguments "compile pgf testsuite/lpgf/Foods*.gf +RTS -T -RTS"
stack bench --benchmark-arguments "compile lpgf Foods*.gf +RTS -T -RTS" stack bench --benchmark-arguments "compile lpgf testsuite/lpgf/Foods*.gf +RTS -T -RTS"
stack bench --benchmark-arguments "run pgf Foods.pgf foods.trees +RTS -T -RTS" stack bench --benchmark-arguments "run pgf Foods.pgf testsuite/lpgf/foods-all.trees +RTS -T -RTS"
stack bench --benchmark-arguments "run pgf2 Foods.pgf foods.trees +RTS -T -RTS" stack bench --benchmark-arguments "run pgf2 Foods.pgf testsuite/lpgf/foods-all.trees +RTS -T -RTS"
stack bench --benchmark-arguments "run lpgf Foods.lpgf foods.trees +RTS -T -RTS" stack bench --benchmark-arguments "run lpgf Foods.lpgf testsuite/lpgf/foods-all.trees +RTS -T -RTS"
``` ```

23
testsuite/lpgf/bench.hs
View File

@@ -9,7 +9,7 @@ import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, m
import Control.DeepSeq (force) import Control.DeepSeq (force)
import Control.Exception (evaluate) import Control.Exception (evaluate)
import Control.Monad (when) import Control.Monad (when, forM)
import qualified Data.List as L import qualified Data.List as L
import Data.Maybe (fromJust, isJust, isNothing) import Data.Maybe (fromJust, isJust, isNothing)
import qualified Data.Map as Map import qualified Data.Map as Map
@@ -18,7 +18,7 @@ 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, dropExtension) import System.FilePath ((</>), (<.>), takeFileName, takeDirectory, dropExtension)
import Text.Printf (printf) import Text.Printf (printf)
import GHC.Stats import GHC.Stats
@@ -43,11 +43,22 @@ main = do
when (mode == "compile" && argc < 2) (die usage) when (mode == "compile" && argc < 2) (die usage)
when (mode == "run" && argc < 3) (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 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 [] let mods' = if mode == "compile" then drop (if isJust target then 2 else 1) args else []
mods <- concat <$> forM mods' (\mod ->
-- If * is supplied in module name, collect modules ourselves -- If * is supplied in module name, collect modules ourselves
-- mods <- map (dir </>) if '*' `elem` mod
-- . filter (\p -> grammarName `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf") then do
-- <$> listDirectory dir let
dir = takeDirectory mod
pre = takeWhile (/='*') (takeFileName mod)
post = drop 1 $ dropWhile (/='*') (takeFileName mod)
map (dir </>)
. filter (\p -> let fn = takeFileName p in pre `L.isPrefixOf` fn && post `L.isSuffixOf` fn)
<$> listDirectory dir
else
return [mod]
)
let binaryFile = if mode == "run" then Just $ args !! (if isJust target then 2 else 1) else Nothing let binaryFile = if mode == "run" then Just $ args !! (if isJust target then 2 else 1) else Nothing
let treesFile = if mode == "run" then Just $ args !! (if isJust target then 3 else 2) else Nothing let treesFile = if mode == "run" then Just $ args !! (if isJust target then 3 else 2) else Nothing