msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

Add PFG2 linearisation to benchmark

Browse Source
This commit is contained in:
John J. Camilleri
2021-02-17 15:30:11 +01:00
parent 8e1fa4981f
commit 9a263450f5
2 changed files with 34 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
testsuite/lpgf/README.md
View File

@@ -30,6 +30,7 @@ Comparing PGF, PGF2, LPGF along following criteria:
```
stack build --test --bench --no-run-tests --no-run-benchmarks
stack bench --benchmark-arguments "+RTS -T -RTS"
PGF_ONLY=1 stack bench --benchmark-arguments "+RTS -T -RTS"
LPGF_ONLY=1 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"
```

47
testsuite/lpgf/bench.hs
View File

@@ -2,9 +2,9 @@
module Main where
import qualified LPGF
import LPGF (LPGF)
import qualified PGF
import PGF (PGF)
import qualified PGF2
import GF (compileToPGF, compileToLPGF, writePGF, writeLPGF)
import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, modifyFlags)
@@ -16,7 +16,7 @@ import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import System.Directory (listDirectory, getFileSize)
import System.Environment (lookupEnv)
import System.FilePath ((</>), takeBaseName, takeExtension)
import System.FilePath ((</>), (<.>), takeBaseName, takeExtension)
import Text.Printf (printf)
import GHC.Stats
@@ -39,28 +39,39 @@ main = do
mods <- map (dir </>)
. filter (\p -> grammarName `L.isPrefixOf` takeBaseName p && takeExtension p == ".gf")
<$> listDirectory dir
printf "Found modules: %s\n" (unwords mods)
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)
doPGF <- isNothing <$> lookupEnv "LPGF_ONLY"
doLPGF <- isNothing <$> lookupEnv "PGF_ONLY"
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
(path, pgf) <- time "compile PGF" (compilePGF mods)
putStrLn "PGF"
(path, pgf) <- time "compile" (compilePGF mods)
size <- getFileSize path
printf "- PGF size: %s\n" (convertSize size)
time "linearise PGF" (return $ length $ linPGF pgf trees)
printf "- size: %s\n" (convertSize size)
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
(path, lpgf) <- time "compile LPGF" (compileLPGF mods)
putStrLn "LPGF"
(path, lpgf) <- time "compile" (compileLPGF mods)
size <- getFileSize path
printf "- LPGF size: %s\n" (convertSize size)
time "linearise LPGF" (return $ length $ linLPGF lpgf trees)
printf "- size: %s\n" (convertSize size)
time "linearise" (return $ length $ linLPGF lpgf trees)
return ()
stats <- getRTSStats
@@ -83,23 +94,27 @@ time desc io = do
-- printf "- %s: %s\n" desc (show (diffUTCTime end start))
-- return r
compilePGF :: [FilePath] -> IO (FilePath, PGF)
compilePGF :: [FilePath] -> IO (FilePath, PGF.PGF)
compilePGF mods = do
pgf <- compileToPGF options mods
files <- writePGF options pgf
return (head files, pgf)
compileLPGF :: [FilePath] -> IO (FilePath, LPGF)
compileLPGF :: [FilePath] -> IO (FilePath, LPGF.LPGF)
compileLPGF mods = do
lpgf <- compileToLPGF options mods
file <- writeLPGF options lpgf
return (file, lpgf)
linPGF :: PGF -> [PGF.Expr] -> [[String]]
linPGF :: PGF.PGF -> [PGF.Expr] -> [[String]]
linPGF pgf trees =
[ map (PGF.linearize pgf lang) trees | lang <- PGF.languages pgf ]
linLPGF :: LPGF -> [PGF.Expr] -> [[Text]]
linPGF2 :: PGF2.PGF -> [PGF2.Expr] -> [[String]]
linPGF2 pgf trees =
[ map (PGF2.linearize concr) trees | (_, concr) <- Map.toList (PGF2.languages pgf) ]
linLPGF :: LPGF.LPGF -> [PGF.Expr] -> [[Text]]
linLPGF lpgf trees =
[ map (LPGF.linearizeConcreteText concr) trees | (_,concr) <- Map.toList (LPGF.concretes lpgf) ]