Commit 286e6c56 authored by Ben Gamari's avatar Ben Gamari 🐢

More tables

parent 2b3b3957
......@@ -28,15 +28,34 @@ main = do
mtrees <- mapM (fmap (MTree.toMap head . fromJust) . MTree.readFile) files
let aligned = alignMany $ M.fromList $ zip (map takeFileName files) mtrees
let tabulate :: (Show a, Ord a) => String -> (LabelMatcher a) -> IO ()
tabulate heading pred = do
putStrLn $ render show show (maybe "-" (\x -> showGFloat (Just 3) x ""))
$ toTable
$ M.fromList
$ mapMaybe (\(k,v) -> (\k' -> (k',v)) <$> match pred k)
$ M.toList aligned
tabulate "compiler allocations" $ objectCompilerStats <* "bytes allocated"
tabulate "compiler mutator time" $ objectCompilerStats <* "mutator_cpu_seconds"
tabulate "compiler GC time" $ objectCompilerStats <* "GC_cpu_seconds"
tabulate heading pred
| null xs = putStrLn $ heading ++ ": no measurements"
| otherwise = do
putStrLn $ unlines
[ heading
, replicate 20 '='
, ""
, render show show (maybe "-" (\x -> showGFloat (Just 3) x "")) $ toTable xs
, ""
]
where
xs = M.fromList
$ mapMaybe (\(k,v) -> (\k' -> (k',v)) <$> match pred k)
$ M.toList aligned
-- compile-time metrics
tabulate "compiler allocations" $ objectCompilerRtsStats <* "bytes allocated"
tabulate "compiler mutator time" $ objectCompilerRtsStats <* "mutator_cpu_seconds"
tabulate "compiler GC time" $ objectCompilerRtsStats <* "GC_cpu_seconds"
tabulate "executable size" $ testName <* "executable size"
-- run-time metrics
tabulate "bytes allocated" $ runRtsStats <* "bytes allocated"
tabulate "mutator time" $ runRtsStats <* "mutator_cpu_seconds"
tabulate "GC time" $ runRtsStats <* "GC_cpu_seconds"
-- cachegrind
tabulate "instructions" $ cachegrindStats <* "Ir"
tabulate "LLC cache misses" $ cachegrindStats <* "DLmr"
tabulate "L1 cache misses" $ cachegrindStats <* "D1mr"
alignMany :: (Align f, Ord k) => M.Map k (f a) -> f (M.Map k a)
alignMany mtrees =
......@@ -45,9 +64,20 @@ alignMany mtrees =
| (label, mtree) <- M.toList mtrees
]
-- | Test name, module name
objectCompilerStats :: LabelMatcher (String, String)
objectCompilerStats = (,) <$> wildcard <* "objects" <*> wildcard <* "rts stats"
type TestName = String
type ModuleName = String
testName :: LabelMatcher TestName
testName = wildcard
objectCompilerRtsStats :: LabelMatcher (TestName, ModuleName)
objectCompilerRtsStats = (,) <$> testName <* "objects" <*> wildcard <* "rts stats"
runRtsStats :: LabelMatcher TestName
runRtsStats = testName <* "run" <* "rts stats"
cachegrindStats :: LabelMatcher TestName
cachegrindStats = testName <* "run" <* "cachegrind"
toTable :: (Ord r, Ord c)
=> M.Map r (M.Map c a)
......@@ -63,3 +93,4 @@ toTable xs =
]
where
allKeys = toList $ foldMap M.keysSet xs
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment