GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-23 19:42:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Tweak memory reporting and strictness in benchmark

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

39
testsuite/lpgf/bench.hs
View File

@@ -7,7 +7,7 @@ import qualified PGF2
import GF (compileToPGF, compileToLPGF, writePGF, writeLPGF) import GF (compileToPGF, compileToLPGF, writePGF, writeLPGF)
import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, modifyFlags) import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, modifyFlags)
import Control.DeepSeq (force) import Control.DeepSeq (NFData, force)
import Control.Exception (evaluate) import Control.Exception (evaluate)
import Control.Monad (when, forM) import Control.Monad (when, forM)
import qualified Data.List as L import qualified Data.List as L
@@ -71,13 +71,13 @@ main = do
when (mode == "compile") $ do when (mode == "compile") $ do
when doPGF $ do when doPGF $ do
putStrLn "PGF" putStrLn "PGF"
(path, pgf) <- time "compile" (compilePGF mods) (path, pgf) <- time "- compile: " (compilePGF mods)
size <- getFileSize path size <- getFileSize path
printf "- size: %s %s\n" (convertSize size) path printf "- size: %s %s\n" (convertSize size) path
when doLPGF $ do when doLPGF $ do
putStrLn "LPGF" putStrLn "LPGF"
(path, lpgf) <- time "compile" (compileLPGF mods) (path, lpgf) <- time "- compile: " (compileLPGF mods)
size <- getFileSize path size <- getFileSize path
printf "- size: %s %s\n" (convertSize size) path printf "- size: %s %s\n" (convertSize size) path
@@ -92,40 +92,34 @@ main = do
when doPGF $ do when doPGF $ do
putStrLn "PGF" putStrLn "PGF"
pgf <- PGF.readPGF (dropExtension (fromJust binaryFile) <.> "pgf") pgf <- PGF.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
time "linearise" (evaluate $ force $ linPGF pgf trees) timePure "- linearise: " (linPGF pgf trees)
return () return ()
when doPGF2 $ do when doPGF2 $ do
putStrLn "PGF2" putStrLn "PGF2"
pgf <- PGF2.readPGF (dropExtension (fromJust binaryFile) <.> "pgf") pgf <- PGF2.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
time "linearise" (evaluate $ force $ linPGF2 pgf trees2) timePure "- linearise: " (linPGF2 pgf trees2)
return () return ()
when doLPGF $ do when doLPGF $ do
putStrLn "LPGF" putStrLn "LPGF"
lpgf <- LPGF.readLPGF (dropExtension (fromJust binaryFile) <.> "lpgf") lpgf <- LPGF.readLPGF (dropExtension (fromJust binaryFile) <.> "lpgf")
time "linearise" (evaluate $ force $ linLPGF lpgf trees) timePure "- linearise: " (linLPGF lpgf trees)
return () return ()
stats <- getRTSStats stats <- getRTSStats
printf "Max live memory: %s\n" (convertSize (read (show (max_live_bytes stats)))) printf "Max memory: %s\n" (convertSize (fromIntegral (max_mem_in_use_bytes stats)))
printf "Max used memory: %s\n" (convertSize (read (show (max_mem_in_use_bytes stats))))
time :: String -> IO a -> IO a time :: String -> IO a -> IO a
time desc io = do time desc io = do
start <- getCurrentTime start <- getCurrentTime
r <- io r <- io >>= evaluate -- only WHNF
end <- getCurrentTime end <- getCurrentTime
printf "- %s: %s\n" desc (show (diffUTCTime end start)) putStrLn $ desc ++ show (diffUTCTime end start)
return r return r
-- timePure :: String -> a -> IO a timePure :: (NFData a) => String -> a -> IO a
-- timePure desc val = do timePure desc val = time desc (return $ force val)
-- start <- getCurrentTime
-- let r = val
-- end <- getCurrentTime
-- printf "- %s: %s\n" desc (show (diffUTCTime end start))
-- return r
compilePGF :: [FilePath] -> IO (FilePath, PGF.PGF) compilePGF :: [FilePath] -> IO (FilePath, PGF.PGF)
compilePGF mods = do compilePGF mods = do
@@ -154,7 +148,8 @@ linLPGF lpgf trees =
-- | Produce human readable file size -- | Produce human readable file size
-- Adapted from https://hackage.haskell.org/package/hrfsize -- Adapted from https://hackage.haskell.org/package/hrfsize
convertSize :: Integer -> String convertSize :: Integer -> String
convertSize = convertSize' . fromInteger convertSize = convertSize'' . fromInteger
convertSize' :: Double -> String convertSize' :: Double -> String
convertSize' size convertSize' size
| size < 1024.0 = printf "%.0v bytes" size | size < 1024.0 = printf "%.0v bytes" size
@@ -162,3 +157,11 @@ convertSize' size
| size < 1024.0 ^ (3 :: Int) = printf "%.2v MiB" $ size / 1024.0 ^ (2 :: Int) | size < 1024.0 ^ (3 :: Int) = printf "%.2v MiB" $ size / 1024.0 ^ (2 :: Int)
| size < 1024.0 ^ (4 :: Int) = printf "%.2v GiB" $ size / 1024.0 ^ (3 :: Int) | size < 1024.0 ^ (4 :: Int) = printf "%.2v GiB" $ size / 1024.0 ^ (3 :: Int)
| otherwise = printf "%.2v TiB" $ size / 1024.0 ^ (4 :: Int) | otherwise = printf "%.2v TiB" $ size / 1024.0 ^ (4 :: Int)
convertSize'' :: Double -> String
convertSize'' size
| size < 1000 = printf "%.0v bytes" size
| size < 1000 ^ (2 :: Int) = printf "%.2v KB" $ size / 1000
| size < 1000 ^ (3 :: Int) = printf "%.2v MB" $ size / 1000 ^ (2 :: Int)
| size < 1000 ^ (4 :: Int) = printf "%.2v GB" $ size / 1000 ^ (3 :: Int)
| otherwise = printf "%.2v TB" $ size / 1000 ^ (4 :: Int)