From befd19f6264e775254097edaaed3fbf0559ef674 Mon Sep 17 00:00:00 2001 From: Thomas Miedema Date: Sun, 2 Mar 2025 21:18:06 +0100 Subject: [PATCH] feat: --max-bytes-used (#2) +----------------------------------------------++---------------------------++-----------------------------+ | || Time (s) || Max bytes used | +==============================================++===========================++=============================+ | || hledger-1.40 hledger-1.41 || hledger-1.40 hledger-1.41 | +==============================================++===========================++=============================+ | -f examples/1ktxns-1kaccts.journal balance || 0.21 0.21 || 3.84M 4.28M | | -f examples/2ktxns-1kaccts.journal balance || 0.35 0.33 || 7.43M 6.39M | | -f examples/3ktxns-1kaccts.journal balance || 0.49 0.49 || 10.48M 11.59M | | -f examples/4ktxns-1kaccts.journal balance || 0.53 0.36 || 14.61M 11.49M | | -f examples/5ktxns-1kaccts.journal balance || 0.47 0.41 || 18.32M 15.52M | | -f examples/6ktxns-1kaccts.journal balance || 0.47 0.49 || 21.72M 21.60M | | -f examples/7ktxns-1kaccts.journal balance || 0.55 0.57 || 22.35M 25.17M | | -f examples/8ktxns-1kaccts.journal balance || 0.61 0.64 || 22.28M 24.02M | | -f examples/9ktxns-1kaccts.journal balance || 0.70 0.67 || 31.41M 24.03M | | -f examples/10ktxns-1kaccts.journal balance || 0.77 0.78 || 36.00M 35.56M | | -f examples/20ktxns-1kaccts.journal balance || 1.52 1.55 || 72.62M 72.62M | | -f examples/30ktxns-1kaccts.journal balance || 2.19 2.29 || 85.87M 96.99M | | -f examples/40ktxns-1kaccts.journal balance || 2.91 3.04 || 120.17M 130.21M | | -f examples/50ktxns-1kaccts.journal balance || 3.60 3.62 || 129.01M 140.33M | | -f examples/60ktxns-1kaccts.journal balance || 4.28 4.44 || 162.47M 175.05M | | -f examples/70ktxns-1kaccts.journal balance || 4.99 5.07 || 195.87M 207.53M | | -f examples/80ktxns-1kaccts.journal balance || 5.60 5.76 || 211.37M 219.93M | | -f examples/90ktxns-1kaccts.journal balance || 6.34 6.49 || 241.11M 250.92M | | -f examples/100ktxns-1kaccts.journal balance || 6.90 7.01 || 255.24M 264.18M | +----------------------------------------------++---------------------------++-----------------------------+ --- quickbench.1.md | 3 ++ src/QuickBench.hs | 91 ++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 82 insertions(+), 12 deletions(-) diff --git a/quickbench.1.md b/quickbench.1.md index 099909a..c8c0b7d 100644 --- a/quickbench.1.md +++ b/quickbench.1.md @@ -44,6 +44,9 @@ With -w, commands' first words are replaced with a new executable `-p, --precision=N` : show times with this many decimal places [default: 2] +`-m, --max-bytes-used` +: measure max residency (Haskell programs compiled with `-rtsopts` only) + `-v, --verbose` : show commands being run diff --git a/src/QuickBench.hs b/src/QuickBench.hs index 696a309..ad59e87 100755 --- a/src/QuickBench.hs +++ b/src/QuickBench.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} module QuickBench @@ -9,10 +11,11 @@ module QuickBench where -- import Debug.Trace -import Control.Exception +import Control.Exception hiding (handle) import Control.Monad import Data.Char (isSpace) -import Data.List +import Data.Functor +import Data.List hiding (group) import Data.List.Split (splitOn) import Data.Maybe import Data.Time.Clock @@ -29,6 +32,7 @@ import Text.Megaparsec (ParsecT, Stream (Token), between, many, noneOf, runParse import Text.Megaparsec.Char (char) import Text.Show.Pretty import Text.Printf +import Text.Read import Text.Tabular import qualified Text.Tabular.AsciiArt as TA @@ -58,6 +62,7 @@ Options: -n, --iterations=N run each command this many times [default: 1] -N, --cycles=N run the whole suite this many times [default: 1] -p, --precision=N show times with this many decimal places [default: 2] + -m, --max-bytes-used measure max residency (Haskell programs compiled with `-rtsopts` only) -v, --verbose show the commands being run -V, --more-verbose show the commands' output --debug show this program's debug output @@ -74,6 +79,7 @@ data Opts = Opts { ,iterations :: Int ,cycles :: Int ,precision :: Int + ,maxBytesUsed:: Bool ,verbose :: Bool ,moreVerbose :: Bool ,debug :: Bool @@ -109,6 +115,7 @@ getOpts = do ,precision = precision' ,verbose = flag "verbose" ,moreVerbose = flag "more-verbose" + ,maxBytesUsed= flag "max-bytes-used" ,debug = flag "debug" ,help = flag "help" ,clicmds = args @@ -186,14 +193,29 @@ getCurrentZonedTime = do tz <- getCurrentTimeZone return $ utcToZonedTime tz t -runTestWithExes :: Opts -> [String] -> String -> IO [[Float]] +runTestWithExes :: Opts -> [String] -> String -> IO [[(Float, Maybe Int)]] runTestWithExes opts exes cmd = mapM (runTestWithExe opts cmd) exes -runTestWithExe :: Opts -> String -> String -> IO [Float] +runTestWithExe :: Opts -> String -> String -> IO [(Float, Maybe Int)] runTestWithExe opts cmd exe = mapM (runTestOnce opts cmd exe) [1..iterations opts] -runTestOnce :: Opts -> String -> String -> Int -> IO Float -runTestOnce opts cmd exe iteration = do +runTestOnce :: Opts -> String -> String -> Int -> IO (Float, Maybe Int) +runTestOnce opts cmd exe iteration = if maxBytesUsed opts + then runTimeAndResidencyTest opts cmd exe iteration + else runTimeTest opts cmd exe iteration <&> (,Nothing) + +runTimeAndResidencyTest :: Opts -> String -> String -> Int -> IO (Float, Maybe Int) +runTimeAndResidencyTest opts cmd exe iteration = withTempFile $ \name handle -> do + t <- runTimeTest opts (cmd ++ " +RTS --machine-readable -t" ++ name) exe iteration + _ <- hGetLine handle -- skip first line + stats <- hGetContents' handle + return (t, readMaybe stats >>= findMaxBytesUsed) + where + findMaxBytesUsed :: [(String, String)] -> Maybe Int + findMaxBytesUsed pairs = find ((== "max_bytes_used") . fst) pairs >>= readMaybe . snd + +runTimeTest :: Opts -> String -> String -> Int -> IO Float +runTimeTest opts cmd exe iteration = do let (cmd',exe',args) = replaceExecutable exe cmd when (not $ null exe) $ dbg opts $ "replaced executable with " <> show exe outv opts (show iteration ++ ": " ++ cmd' ++ "\n") @@ -231,7 +253,7 @@ readProcessWithExitCode' exe args inp = readProcessWithExitCode exe args inp `catch` \(e :: IOException) -> return (ExitFailure 1, "", show e) -printSummary :: Opts -> [String] -> [String] -> Int -> [[[Float]]] -> IO () +printSummary :: Opts -> [String] -> [String] -> Int -> [[[(Float, Maybe Int)]]] -> IO () printSummary opts cmds exes cyc results = do out opts $ printf "\nBest times%s:\n" (if cycles opts > 1 then " "++show cyc else "") let t = maketable opts cmds' exes results @@ -246,15 +268,43 @@ printSummary opts cmds exes cyc results = do [e] -> [c | (c,_,_) <- map (replaceExecutable e) cmds] _ -> map (unwords . drop 1 . words) cmds -maketable :: Opts -> [String] -> [String] -> [[[Float]]] -> Table String String String -maketable opts rownames colnames results = Table rowhdrs colhdrs rows +maketable :: Opts -> [String] -> [String] -> [[[(Float, Maybe Int)]]] -> Table String String String +maketable opts rownames colnames results = Table rowhdrs grouphdrs (firstrow:rows) + where + rowhdrs = makeRowHeaders rownames + grouphdrs = makeGroupHeaders opts colnames + firstrow = colnames ++ colnames + rows = map (makeRow opts) results + +makeRowHeaders :: [String] -> Header String +makeRowHeaders rownames = Group DoubleLine [ + Group NoLine [Header ""], + Group NoLine $ map Header $ padright rownames + ] where - rowhdrs = Group NoLine $ map Header $ padright rownames - colhdrs = Group SingleLine $ map Header colnames - rows = map (map (showtime opts . minimum)) results padright ss = map (printf (printf "%%-%ds" w)) ss where w = maximum $ map length ss +{- +makeColumnHeaders :: Opts -> [String] -> Header String +makeColumnHeaders opts colnames = + Group DoubleLine . replicate (if maxBytesUsed opts then 2 else 1) . Group SingleLine $ map Header colnames +-} + +-- Workaround for https://github.com/bgamari/tabular/issues/4 +makeGroupHeaders :: Opts -> [String] -> Header String +makeGroupHeaders opts colnames = + Group DoubleLine $ map (Group NoLine . headers) groups + where + groups = if maxBytesUsed opts then ["Time (s)", "Max bytes used"] else ["Time (s)"] + headers group = take (length colnames) . map Header $ group:repeat "" + +makeRow :: Opts -> [[(Float, Maybe Int)]] -> [String] +makeRow opts results = if maxBytesUsed opts then times ++ bytes else times + where + times = map (showtime opts . minimum . map fst) results + bytes = map (showbytes opts . minimum . map (fromMaybe 0 . snd)) results + --------------------------------------- -- utils @@ -278,6 +328,23 @@ dbg opts s = when (debug opts) $ err s showtime :: Opts -> (Float -> String) showtime opts = printf $ "%." ++ show (precision opts) ++ "f" +showbytes :: Opts -> Int -> String +showbytes opts n + | abs n >= 1000_000_000 = printf ("%." ++ show (precision opts) ++ "fG") (fromIntegral n / 1000_0000_0000 :: Double) + | abs n >= 1000_000 = printf ("%." ++ show (precision opts) ++ "fM") (fromIntegral n / 1000_0000 :: Double) + | abs n >= 1000 = printf ("%." ++ show (precision opts) ++ "fK") (fromIntegral n / 1000 :: Double) + | otherwise = show n + +withTempFile :: (FilePath -> Handle -> IO a) -> IO a +withTempFile action = do + tmp_dir <- getTemporaryDirectory >>= canonicalizePath + bracket + (openTempFile tmp_dir "quickbench-") + (\(name, handle) -> hClose handle >> ignoringIOErrors (removeFile name)) + (uncurry action) + where + ignoringIOErrors = void . (try :: IO a -> IO (Either IOException a)) + -- Strings -- | Remove leading and trailing whitespace.