More tables

shake/Compare.hs

@@ -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
+