Add a little colour to benchmark output

This commit is contained in:
John J. Camilleri
2021-03-04 10:20:57 +01:00
parent 30b016032d
commit 0ba0438dc7
2 changed files with 13 additions and 5 deletions

View File

@@ -733,6 +733,7 @@ benchmark lpgf-bench
cc-options: -std=c99
build-depends:
ansi-terminal,
array,
base>=4.6 && <5,
bytestring,

View File

@@ -15,6 +15,7 @@ import Data.Maybe (fromJust, isJust, isNothing)
import qualified Data.Map as Map
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import System.Console.ANSI
import System.Directory (listDirectory, getFileSize)
import System.Environment (getArgs)
import System.Exit (die)
@@ -70,13 +71,13 @@ main = do
-- Compilation
when (mode == "compile") $ do
when doPGF $ do
putStrLn "PGF"
heading "PGF"
(path, pgf) <- time "- compile: " (compilePGF mods)
size <- getFileSize path
printf "- size: %s %s\n" (convertSize size) path
when doLPGF $ do
putStrLn "LPGF"
heading "LPGF"
(path, lpgf) <- time "- compile: " (compileLPGF mods)
size <- getFileSize path
printf "- size: %s %s\n" (convertSize size) path
@@ -90,19 +91,19 @@ main = do
printf "Read %d trees\n" (length trees)
when doPGF $ do
putStrLn "PGF"
heading "PGF"
pgf <- PGF.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
timePure "- linearise: " (linPGF pgf trees)
return ()
when doPGF2 $ do
putStrLn "PGF2"
heading "PGF2"
pgf <- PGF2.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
timePure "- linearise: " (linPGF2 pgf trees2)
return ()
when doLPGF $ do
putStrLn "LPGF"
heading "LPGF"
lpgf <- LPGF.readLPGF (dropExtension (fromJust binaryFile) <.> "lpgf")
timePure "- linearise: " (linLPGF lpgf trees)
return ()
@@ -110,6 +111,12 @@ main = do
stats <- getRTSStats
printf "Max memory: %s\n" (convertSize (fromIntegral (max_mem_in_use_bytes stats)))
heading :: String -> IO ()
heading s = do
setSGR [SetColor Foreground Vivid Yellow, SetConsoleIntensity BoldIntensity]
putStrLn s
setSGR [Reset]
time :: String -> IO a -> IO a
time desc io = do
start <- getCurrentTime