Add PFG2 linearisation to benchmark

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"
 ```

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) ]