gc/cacheprof/Makefile

@@ -2,10 +2,10 @@ TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H16m -RTS
+PROG_ARGS += +RTS -H16m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/circsim/Makefile

@@ -7,10 +7,10 @@ NORM_OPTS = 8 3000
 SLOW_OPTS = 8 5000
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H256m -RTS
+PROG_ARGS += +RTS -H256m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H30m -RTS
+PROG_ARGS += +RTS -H30m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/constraints/Makefile

@@ -7,10 +7,10 @@ NORM_OPTS = 10
 SLOW_OPTS = 11
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H330m -RTS
+PROG_ARGS += +RTS -H330m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/fibheaps/Makefile

@@ -4,13 +4,13 @@ include $(TOP)/mk/boilerplate.mk
 NORM_OPTS = 300000
 
 SRC_HC_OPTS += -package array
-SRC_RUNTEST_OPTS += +RTS -K64m -RTS
+PROG_ARGS += +RTS -K64m -RTS
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H128m -RTS
+PROG_ARGS += +RTS -H128m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/fulsom/Makefile

@@ -11,10 +11,10 @@ NORM_OPTS = 9
 SLOW_OPTS = 9
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H160m -RTS
+PROG_ARGS += +RTS -H160m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 SRC_RUNTEST_OPTS += -stdout-binary

gc/gc_bench/Makefile

@@ -13,7 +13,7 @@ NORM_OPTS = 18 500000 4 19
 SLOW_OPTS = 19 500000 5 22
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H180m -RTS
+PROG_ARGS += +RTS -H180m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/happy/Makefile

@@ -7,10 +7,10 @@ SRC_HC_OPTS += -cpp -package containers
 EXCLUDED_SRCS += TestInput.hs
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H128m -RTS
+PROG_ARGS += +RTS -H128m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/hash/Makefile

@@ -6,7 +6,7 @@ NORM_OPTS = 5000000
 SLOW_OPTS = 100000000
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H430m -RTS
+PROG_ARGS += +RTS -H430m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/lcss/Makefile

@@ -6,7 +6,7 @@ NORM_OPTS = 1 2 2000 1000 1001 4000
 SLOW_OPTS = 1 2 4000 1000 1001 4000
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H256m -RTS
+PROG_ARGS += +RTS -H256m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/linear/Makefile

@@ -5,10 +5,10 @@ include $(TOP)/mk/boilerplate.mk
 NORM_OPTS = 14
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H8m -RTS
+PROG_ARGS += +RTS -H8m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/power/Makefile

@@ -8,8 +8,8 @@ NORM_OPTS = 80
 SLOW_OPTS = 90
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H16m -RTS
+PROG_ARGS += +RTS -H16m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif

gc/spellcheck/Makefile

@@ -11,10 +11,10 @@ SRC_HC_OPTS += -package containers
 NORM_OPTS = words input
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H32m -RTS
+PROG_ARGS += +RTS -H32m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H10m -RTS
+PROG_ARGS += +RTS -H10m -RTS
 endif
 
 include $(TOP)/mk/target.mk

gc/treejoin/Makefile

@@ -5,10 +5,10 @@ include $(TOP)/mk/boilerplate.mk
 PROG_ARGS = 27000.1 27000.2
 
 ifeq "$(HEAP)" "LARGE"
-SRC_RUNTEST_OPTS += +RTS -H32m -RTS
+PROG_ARGS += +RTS -H32m -RTS
 endif
 ifeq "$(HEAP)" "OLD"
-SRC_RUNTEST_OPTS += +RTS -H24m -RTS
+PROG_ARGS += +RTS -H24m -RTS
 endif
 
 include $(TOP)/mk/target.mk

imaginary/integrate/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += +RTS -K20m -H100m -RTS
+PROG_ARGS += +RTS -K20m -H100m -RTS
 
 -include opts.mk
 include $(TOP)/mk/target.mk

imaginary/paraffins/Makefile

@@ -4,7 +4,7 @@ include $(TOP)/mk/boilerplate.mk
 # Override default SRCS; the default is all source files, but
 # we don't want to include paraffins.c
 SRCS=Main.hs
-SRC_RUNTEST_OPTS += +RTS -H20m -RTS
+PROG_ARGS += +RTS -H20m -RTS
 
 include $(TOP)/mk/target.mk
 

imaginary/wheel-sieve2/Makefile

@@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk
 -include opts.mk
 
 # Seems to be a real memory hog, this one
-SRC_RUNTEST_OPTS += +RTS -M300m -RTS
+PROG_ARGS += +RTS -M300m -RTS
 
 include $(TOP)/mk/target.mk
 

parallel/OLD/par001/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += 8400
+PROG_ARGS += 8400
 
 include $(TOP)/mk/target.mk
 

parallel/OLD/parfact/Makefile

@@ -4,7 +4,7 @@ include $(TOP)/mk/boilerplate.mk
 
 # Override default SRCS; the default is all source files
 SRCS=parfact.hs
-SRC_RUNTEST_OPTS += 8000000 1000
+PROG_ARGS += 8000000 1000
 SRC_HC_OPTS += -package concurrent
 
 include $(TOP)/mk/target.mk

parallel/OLD/soda7/Makefile

@@ -3,7 +3,7 @@ include $(TOP)/mk/boilerplate.mk
 
 # Override default SRCS; the default is all source files
 SRCS=Main.hs
-SRC_RUNTEST_OPTS += 20
+PROG_ARGS += 20
 SRC_HC_OPTS += -cpp -package concurrent
 
 include $(TOP)/mk/target.mk

parallel/coins/Makefile

@@ -2,10 +2,10 @@ TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
 # This version just counts the results, and runs in constant space:
-# SRC_RUNTEST_OPTS += 7 1163
+# PROG_ARGS += 7 1163
 
 # This version builds a list of the results, and needs a lot of memory:
-SRC_RUNTEST_OPTS += 3 873
+PROG_ARGS += 3 873
 
 SRC_HC_OPTS += -package parallel
 

parallel/linsolv/Makefile

@@ -5,7 +5,7 @@ SRC_HC_OPTS += -cpp -DSTRATEGIES -package random -package parallel
 
 # 28 = version
 # 83 = input
-PROG_ARGS = 28 83
+PROG_ARGS += 28 83
 
 include $(TOP)/mk/target.mk
 

parallel/mandel/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += -2.0 -2.0 2.0 2.0 1024 1024 256
+PROG_ARGS += -2.0 -2.0 2.0 2.0 1024 1024 256
 SRC_RUNTEST_OPTS += -stdout-binary
 SRC_HC_OPTS += -package parallel
 

parallel/minimax/Makefile

@@ -7,9 +7,9 @@ SRCS = Board.hs \
 		 Tree.hs \
 		 Wins.hs \
 		 Main.hs
-HC_OPTS += -package parallel -package random
+SRC_HC_OPTS += -package parallel -package random
 
-PROG_ARGS = 4 6
+PROG_ARGS += 4 6
 
 include $(TOP)/mk/target.mk
 

parallel/nbody/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-PROG_ARGS = 3000
+PROG_ARGS += 3000
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

parallel/parfib/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += 43 11
+PROG_ARGS += 43 11
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

parallel/partree/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-PROG_ARGS = 300 100
+PROG_ARGS += 300 100
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

parallel/prsa/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-PROG_ARGS = 500000
+PROG_ARGS += 500000
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

parallel/queens/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += 13
+PROG_ARGS += 13
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

parallel/ray/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-PROG_ARGS = 1000
+PROG_ARGS += 1000
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

parallel/sumeuler/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-PROG_ARGS = 38 8000 100
+PROG_ARGS += 38 8000 100
 SRC_HC_OPTS += -package parallel
 
 # FAST_OPTS = 

parallel/transclos/Makefile

@@ -13,7 +13,7 @@ SRC_HC_OPTS += -O0
 #   10 is about optimal for 7.1, greater degrades perf (less so for local-gc)
 # dummy = 999 (always)
 # delay = larger for 
-PROG_ARGS = 4 10 10 999 24
+PROG_ARGS += 4 10 10 999 24
 
 include $(TOP)/mk/target.mk
 

parallel/warshall/Makefile

@@ -13,7 +13,7 @@
 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += 400 400
+PROG_ARGS += 400 400
 SRC_HC_OPTS += -package parallel
 
 include $(TOP)/mk/target.mk

real/compress2/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += -stdout-binary
+PROG_ARGS += -stdout-binary
 
 SRC_HC_OPTS += -fglasgow-exts
 
-SRC_RUNTEST_OPTS += +RTS -H100m -RTS
+PROG_ARGS += +RTS -H100m -RTS
 
 include $(TOP)/mk/target.mk
 

real/hidden/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += +RTS -K1m -RTS
+PROG_ARGS += +RTS -K1m -RTS
 PROG_ARGS = runtime_files/four.plate
 
 include $(TOP)/mk/target.mk

real/hpg/Makefile

 TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
-SRC_RUNTEST_OPTS += +RTS -H50m -RTS
+PROG_ARGS += +RTS -H50m -RTS
 
 FAST_OPTS = -nt 8 -dt 6 -nv 15 -dv 8 -de 8
 NORM_OPTS = -nt 80 -dt 10 -nv 100 -dv 10 -de 10

shake/CachegrindParse.hs

+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module CachegrindParse where
+
+import Data.Maybe
+import qualified Data.Map as M
+
+newtype EventName = EventName { getEventName :: String }
+                  deriving (Show, Eq, Ord)
+
+parse :: FilePath -> IO (M.Map EventName Integer)
+parse fname = parse' <$> readFile fname
+
+parse' :: String -> M.Map EventName Integer
+parse' content =
+    M.fromList $ zip summary events
+  where
+    events = case mapMaybe isEventList $ lines content of
+               [] -> error "No event list found"
+               [x] -> x
+               _ -> error "More than one event list found"
+    summary = case mapMaybe isSummaryList $ lines content of
+               [] -> error "No event summary found"
+               [x] -> x
+               _ -> error "More than one event summary found"
+
+    isEventList :: String -> Maybe [Integer]
+    isEventList line
+      | "summary:" : rest <- words line = Just $ map read rest
+      | otherwise = Nothing
+
+    isSummaryList :: String -> Maybe [EventName]
+    isSummaryList line
+      | "events:" : rest <- words line = Just $ map EventName rest
+      | otherwise = Nothing
+

shake/Compare.hs

+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Align
+import Data.Maybe
+import Data.These
+import Data.List (intercalate, group)
+import Data.Foldable
+import Numeric
+import qualified Data.Sequence as Seq
+import qualified Data.Tree as Tree
+import Data.Tree (Tree)
+import qualified Data.Map.Strict as M
+import System.FilePath
+import Text.Tabular
+import Text.Tabular.AsciiArt
+import Options.Applicative
+
+import qualified MeasurementTree as MTree
+import MeasurementTree (Measurements, Label)
+import LabelMatch
+
+data Mode = RelativeMode | AbsoluteMode
+
+args :: Parser (Mode, [FilePath])
+args =
+  (,)
+  <$> flag RelativeMode AbsoluteMode (long "absolute" <> short 'a' <> help "show absolute metrics")
+  <*> some (argument str (metavar "FILE" <> help "results.json file"))
+
+-- | Pick out the interesting part of a set of filenames for use as a friendly
+-- name. Essentially we just break up all paths into their components and drop
+-- all components common to all.
+friendlyNameFiles :: [FilePath] -> M.Map String FilePath
+friendlyNameFiles files =
+    M.fromList
+    [ (joinPath $ toList name, path)
+    | (path, name) <- M.toList friendlyNames
+    ]
+  where
+    friendlyNames :: M.Map FilePath (Seq.Seq String)
+    friendlyNames =
+        fmap (fmap snd . Seq.filter (not . fst) . Seq.zip isCommon) splitPaths
+      where
+        isCommon :: Seq.Seq Bool
+        isCommon = Seq.fromList $ fmap isCommonComp [0..maximum $ fmap length splitPaths]
+
+    splitPaths :: M.Map FilePath (Seq.Seq String)
+    splitPaths = M.fromList [ (f, Seq.fromList $ splitPath f) | f <- files ]
+
+    isCommonComp :: Int -> Bool
+    isCommonComp n = allEqual $ M.elems $ fmap (Seq.!? n) splitPaths
+
+    allEqual :: Eq a => [a] -> Bool
+    allEqual xs = length (group xs) == 1
+
+main :: IO ()
+main = do
+    (mode, files) <- execParser $ info (helper <*> args) mempty
+    let filesWithFriendlyNames = friendlyNameFiles files
+        -- Yuck. Figure out friendly name of reference set
+        [ref] = [ name
+                | (name, fname) <- M.toList filesWithFriendlyNames
+                , fname == head files
+                ]
+    mtrees <- mapM (fmap (MTree.toMap head . fromJust) . MTree.readFile) filesWithFriendlyNames
+    let aligned = alignMany mtrees
+    let tabulate :: (Show a, Ord a) => String -> (LabelMatcher a) -> IO ()
+        tabulate heading pred
+          | null xs = putStrLn $ heading ++ ": no measurements"
+          | otherwise = do
+              putStrLn $ unlines
+                [ heading
+                , replicate 20 '='
+                , ""
+                , case mode of
+                    RelativeMode ->
+                      let showRel = (maybe "-" (showRelative $ showGFloat (Just 3)))
+                          table = toTable $ toRelativeChange ref xs
+                       in render show show showRel table
+                    AbsoluteMode ->
+                      let showVal = (maybe "-" (\x -> showGFloat (Just 3) x ""))
+                          table = toTable xs
+                       in render show show showVal table
+                , ""
+                ]
+          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" <|> "mut_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 =
+    foldl1 (alignWith (mergeThese M.union))
+    [ fmap (M.singleton label) mtree
+    | (label, mtree) <- M.toList mtrees
+    ]
+
+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)
+        -> Table r c (Maybe a)
+toTable xs =
+    Table
+        (Group NoLine $ map Header $ M.keys xs)
+        (Group NoLine $ map Header allKeys)
+        [ [ M.lookup k ys
+          | k <- allKeys
+          ]
+        | ys <- M.elems xs
+        ]
+  where
+    allKeys = toList $ foldMap M.keysSet xs
+
+data Relative a = Reference a
+                | Relative a
+                | NoReference
+
+showRelative :: (Ord a, RealFloat a, Show a)
+             => (a -> ShowS) -> Relative a -> String
+showRelative showRef  (Reference n) = showRef n ""
+showRelative _showRef (Relative  n) = plus . showFFloat (Just 2) (100*n) $ "%"
+  where plus = if n > 0 then showChar '+' else id
+showRelative _showRef  NoReference  = "no ref"
+
+toRelativeChange :: (Ord r, Ord c, RealFrac a)
+                 => c
+                 -> M.Map r (M.Map c a)
+                 -> M.Map r (M.Map c (Relative a))
+toRelativeChange ref xs = fmap f xs
+  where
+    f ys
+      | Just x0 <- M.lookup ref ys =
+          M.mapWithKey (\k y -> if k == ref then Reference x0 else Relative ((y-x0) / x0)) ys
+      | otherwise = fmap (const NoReference) ys
+

shake/LICENSE

+Copyright (c) 2019, Ben Gamari
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Ben Gamari nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

shake/LabelMatch.hs

+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE GADTs #-}
+
+module LabelMatch where
+
+import Control.Applicative
+import Control.Monad
+import Data.String
+
+import MeasurementTree (Label(..))
+import qualified MeasurementTree as MTree
+
+newtype LabelMatcher a = LabelMatcher (Label -> Maybe (Label, a))
+    deriving (Functor)
+
+match :: LabelMatcher a -> Label -> Maybe a
+match (LabelMatcher f) l = snd <$> f l
+
+instance (a ~ ()) => IsString (LabelMatcher a) where
+    fromString = matchPart
+
+instance Applicative LabelMatcher where
+    pure x = LabelMatcher $ \lbl -> Just (lbl, x)
+    (<*>) = ap
+
+instance Alternative LabelMatcher where
+    LabelMatcher f <|> LabelMatcher g =
+      LabelMatcher $ \lbl -> f lbl <|> g lbl
+    empty = LabelMatcher $ const Nothing
+
+instance Monad LabelMatcher where
+    LabelMatcher f >>= g = LabelMatcher $ \lbl ->
+        case f lbl of
+          Nothing -> Nothing
+          Just (lbl', x) -> let LabelMatcher h = g x
+                             in h lbl'
+
+matchPart :: String -> LabelMatcher ()
+matchPart s = LabelMatcher f
+  where
+    f (Label (x:xs))
+      | x == s = Just (Label xs, ())
+    f _ = Nothing
+
+wildcard :: LabelMatcher String
+wildcard = LabelMatcher f
+  where
+    f (Label (x:xs)) = Just (Label xs, x)
+    f (Label []) = Nothing
+
+end :: LabelMatcher ()
+end = LabelMatcher f
+  where
+    f (Label []) = Just (Label [], ())
+    f (Label _) = Nothing
+

shake/Merge.hs

+import Data.Foldable
+import Options.Applicative
+
+import qualified MeasurementTree as MTree
+import MeasurementTree (Measurements, Label)
+
+args :: Parser (FilePath, [FilePath])
+args = 
+  (,)
+  <$> option str (long "output" <> short 'o' <> help "output file")
+  <*> some (argument str (metavar "FILE" <> help "results.json files"))
+
+main :: IO ()
+main = do
+    (output, files) <- execParser $ info (helper <*> args) mempty
+    trees <- mapM (fmap (maybe (error "uh oh") id) . MTree.readFile) files
+    MTree.writeFile output (fold trees)
+

shake/ParseResults.hs

+module ParseResults 
+  ( parseCodeSize
+  , parseRtsStats
+  ) where
+
+import qualified Data.Map.Strict as M
+import Data.Maybe
+
+-- | Parse text section size out of Berkley-format @size@ output
+parseCodeSize :: String -> Integer
+parseCodeSize content
+  | header : sizes : _ <- lines content
+  , "text" : _ <- words header =
+      read $ head $ words sizes
+  | otherwise = error "unrecognized size output"
+
+parseRtsStats :: String -> M.Map String Double
+parseRtsStats = foldMap parseValue . readPairs . dropFirstLine
+  where
+    parseValue (name, value)
+      | (x, ""):_ <- reads value = M.singleton name x
+      | otherwise = M.empty
+
+    dropFirstLine = unlines . drop 1 . lines
+
+    readPairs :: String -> [(String, String)]
+    readPairs s
+      | (x, _):_ <- reads s = x
+      | otherwise = error $ "Failed to parse RTS statistics: " ++ s

shake/Setup.hs

+import Distribution.Simple
+main = defaultMain

shake/nofib-run.cabal

+cabal-version:       >=1.10
+name:                nofib
+version:             0.1.0.0
+-- synopsis:
+-- description:
+-- bug-reports:
+license:             BSD3
+license-file:        LICENSE
+author:              Ben Gamari
+maintainer:          ben@smart-cactus.org
+-- copyright:
+-- category:
+build-type:          Simple
+
+library
+  exposed-modules:     MeasurementTree
+  hs-source-dirs:      src
+  build-depends:       base >=4.10 && <4.13,
+                       aeson,
+                       these >= 0.8,
+                       containers,
+                       bytestring
+  default-language:    Haskell2010
+
+executable nofib-run
+  main-is:             Main.hs
+  other-modules:       CachegrindParse, ParseResults
+  other-extensions:    RecordWildCards, DeriveDataTypeable
+  build-depends:       base >=4.10 && <4.13,
+                       time >=1.8 && <1.9,
+                       containers,
+                       bytestring,
+                       directory >=1.3 && <1.4,
+                       process >=1.6 && <1.7,
+                       cmdargs,
+                       shake,
+                       nofib
+  default-language:    Haskell2010
+
+executable nofib-compare
+  main-is:             Compare.hs
+  other-modules:       LabelMatch
+  other-extensions:    RecordWildCards, DeriveDataTypeable
+  build-depends:       base >=4.10 && <4.13,
+                       these,
+                       containers,
+                       filepath,
+                       aeson,
+                       ansi-wl-pprint,
+                       tabular,
+                       optparse-applicative,
+                       nofib
+  default-language:    Haskell2010
+
+executable nofib-merge
+  main-is:             Merge.hs
+  build-depends:       base >=4.10 && <4.13,
+                       optparse-applicative,
+                       nofib
+  default-language:    Haskell2010

shake/src/MeasurementTree.hs

+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module MeasurementTree where
+
+import Data.String (IsString(..))
+import Data.Bifunctor
+import Data.Maybe
+import Control.Applicative
+import Control.Monad
+import Data.Aeson
+import qualified Data.Map.Strict as M
+import GHC.Generics
+import qualified Data.ByteString.Lazy as BSL
+
+newtype Label = Label { getLabel :: [String] }
+              deriving (Eq, Ord, Show, Monoid, Semigroup,
+                        ToJSON, FromJSON, ToJSONKey, FromJSONKey)
+instance IsString Label where
+    fromString s = Label [s]
+
+mkLabel :: String -> Label
+mkLabel = fromString
+
+newtype Measurements a = Measurements [(Label, a)]
+    deriving (Show, Functor, Monoid, Semigroup, ToJSON, FromJSON)
+
+toMap :: ([a] -> b) -> Measurements a -> M.Map Label b
+toMap f (Measurements xs) = 
+    fmap f $ M.fromListWith (<>) [ (x, [y]) | (x,y) <- xs ]
+
+fromMap :: M.Map Label a -> Measurements a
+fromMap = Measurements . M.toList
+
+prefix :: Label -> Measurements a -> Measurements a
+prefix lbl (Measurements xs) = Measurements $ map (first (lbl<>)) xs
+
+singleton :: Label -> a -> Measurements a
+singleton lbl x = Measurements [(lbl, x)]
+
+fromList :: [(Label, a)] -> Measurements a
+fromList = Measurements
+
+filterByLabel :: (Label -> Bool) -> Measurements a -> Measurements a
+filterByLabel f (Measurements xs) = Measurements $ filter (f . fst) xs
+
+mapLabels :: (Label -> Maybe Label) -> Measurements a -> Measurements a
+mapLabels f (Measurements xs) =
+    Measurements $ mapMaybe (\(k,v) -> (\k' -> (k', v)) <$> f k) xs
+
+writeFile' :: ToJSON a => FilePath -> Measurements a -> IO ()
+writeFile' fname = BSL.writeFile fname . encode
+
+writeFile :: FilePath -> Measurements Double -> IO ()
+writeFile = writeFile'
+
+readFile' :: FromJSON a => FilePath -> IO (Maybe (Measurements a))
+readFile' fname = decode <$> BSL.readFile fname
+
+readFile :: FilePath -> IO (Maybe (Measurements Double))
+readFile = readFile'
+
+mean :: RealFrac a => [a] -> a
+mean xs = sum xs / realToFrac (length xs)
+
+geomMean :: RealFloat a => [a] -> a
+geomMean = exp . mean . map log
+
+stdDev :: RealFloat a => [a] -> a
+stdDev xs = sqrt $ mean $ map (\x -> (x-m)^(2::Int)) xs
+  where m = mean xs
+

spectral/circsim/Makefile

@@ -6,6 +6,6 @@ FAST_OPTS = 8 100
 NORM_OPTS = 8 3000
 SLOW_OPTS = 8 5000
 
-SRC_RUNTEST_OPTS += +RTS -H30m -RTS
+PROG_ARGS += +RTS -H30m -RTS
 
 include $(TOP)/mk/target.mk

spectral/simple/Makefile

@@ -7,6 +7,6 @@ SRCS = Main.hs
 # Main is rather big
 Main_HC_OPTS = -H110m
 
-SRC_RUNTEST_OPTS += +RTS -K3m -H20m -RTS
+PROG_ARGS += +RTS -K3m -H20m -RTS
 
 include $(TOP)/mk/target.mk

spectral/treejoin/Makefile

@@ -2,7 +2,7 @@ TOP = ../..
 include $(TOP)/mk/boilerplate.mk
 
 # Arguments to test program
-SRC_RUNTEST_OPTS += +RTS -K3m -H24m -RTS
+PROG_ARGS += +RTS -K3m -H24m -RTS
 PROG_ARGS = runtime_files/27000.1 runtime_files/27000.2
 
 include $(TOP)/mk/target.mk