diff --git a/testsuite/lpgf/README.md b/testsuite/lpgf/README.md index 4a02416fd..ee8a459f3 100644 --- a/testsuite/lpgf/README.md +++ b/testsuite/lpgf/README.md @@ -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" ``` diff --git a/testsuite/lpgf/bench.hs b/testsuite/lpgf/bench.hs index 65dc96e6b..18bb90e34 100644 --- a/testsuite/lpgf/bench.hs +++ b/testsuite/lpgf/bench.hs @@ -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) ]