Move nofib-analyse from the GHC repo
authorIan Lynagh <igloo@earth.li>
Fri, 15 May 2009 19:58:47 +0000 (19:58 +0000)
committerIan Lynagh <igloo@earth.li>
Fri, 15 May 2009 19:58:47 +0000 (19:58 +0000)
Makefile
nofib-analyse/CmdLine.hs [new file with mode: 0644]
nofib-analyse/GenUtils.lhs [new file with mode: 0644]
nofib-analyse/Main.hs [new file with mode: 0644]
nofib-analyse/Makefile [new file with mode: 0644]
nofib-analyse/Slurp.hs [new file with mode: 0644]

index 0934815..cc9e0e7 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -18,7 +18,7 @@ include $(TOP)/mk/boilerplate.mk
 # As usual,if you want to override these, create
 # $(TOP)/../mk/build.mk containing the flags and options
 # you want to use in a build tree.
-SUBDIRS = runstdtest $(NoFibSubDirs)
+SUBDIRS = runstdtest nofib-analyse $(NoFibSubDirs)
 
 
 # Include the standard targets, one of which
diff --git a/nofib-analyse/CmdLine.hs b/nofib-analyse/CmdLine.hs
new file mode 100644 (file)
index 0000000..8b60626
--- /dev/null
@@ -0,0 +1,95 @@
+-----------------------------------------------------------------------------
+-- CmdLine.hs
+
+-- (c) Simon Marlow 2005
+-----------------------------------------------------------------------------
+
+module CmdLine
+    (
+    flags, other_args, cmdline_errors,
+    devs, nodevs, tooquick_threshold, reportTitle,
+    CLIFlags(..), usage,
+    )
+    where
+
+import System.Console.GetOpt
+import System.Environment      ( getArgs )
+import System.IO.Unsafe                ( unsafePerformIO )
+
+-----------------------------------------------------------------------------
+-- Command line arguments
+
+args :: [String]
+args = unsafePerformIO getArgs
+
+flags :: [CLIFlags]
+other_args :: [String]
+cmdline_errors :: [String]
+(flags, other_args, cmdline_errors) = getOpt Permute argInfo args 
+
+default_tooquick_threshold, tooquick_threshold :: Float
+default_tooquick_threshold = 0.2 {- secs -}
+tooquick_threshold
+ = case [ i | OptIgnoreSmallTimes i <- flags ] of
+       [] -> default_tooquick_threshold
+       (i:_) -> i
+
+devs, nodevs :: Bool
+devs   = OptDeviations   `elem` flags
+nodevs = OptNoDeviations `elem` flags
+
+default_title, reportTitle :: String
+default_title = "NoFib Results"
+reportTitle = case [ t | OptTitle t <- flags ] of
+        []    -> default_title
+        (t:_) -> t
+
+data CLIFlags
+  = OptASCIIOutput
+  | OptLaTeXOutput (Maybe String)
+  | OptHTMLOutput
+  | OptIgnoreSmallTimes Float
+  | OptDeviations
+  | OptNoDeviations
+  | OptTitle String
+  | OptColumns String
+  | OptRows String
+  | OptCSV String
+  | OptNormalise String
+  | OptHelp
+  deriving Eq
+
+usageHeader :: String
+usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
+
+usage :: String
+usage = usageInfo usageHeader argInfo
+
+argInfo :: [ OptDescr CLIFlags ]
+argInfo = 
+  [ Option ['?'] ["help"]    (NoArg OptHelp)        
+       "Display this message"
+  , Option ['a'] ["ascii"]   (NoArg OptASCIIOutput) 
+       "Produce ASCII output (default)"
+  , Option ['h'] ["html"]    (NoArg OptHTMLOutput)  
+       "Produce HTML output"
+  , Option ['i'] ["ignore"]  (ReqArg (OptIgnoreSmallTimes . read) "secs")
+       "Ignore runtimes smaller than <secs>"
+  , Option ['d'] ["deviations"] (NoArg OptDeviations)
+       "Display deviations (default)"
+  , Option ['l'] ["latex"]    (OptArg OptLaTeXOutput "TABLE")
+       "Produce LaTeX output"
+  , Option [] ["columns"] (ReqArg OptColumns "COLUMNS")
+       "Specify columns for summary table (comma separates)"
+  , Option [] ["rows"] (ReqArg OptRows "ROWS")
+       "Specify rows for summary table (comma separates)"
+  , Option [] ["csv"] (ReqArg OptCSV "TABLE")
+       "Output a single table in CSV format"
+  , Option [] ["normalise"] (ReqArg OptNormalise "percent|ratio|none")
+       "normalise to the baseline"
+  , Option ['n'] ["nodeviations"] (NoArg OptNoDeviations)
+       "Hide deviations"
+  , Option ['t'] ["title"] (ReqArg OptTitle "title")
+       "Specify report title"
+  ]
+
diff --git a/nofib-analyse/GenUtils.lhs b/nofib-analyse/GenUtils.lhs
new file mode 100644 (file)
index 0000000..6a1fb76
--- /dev/null
@@ -0,0 +1,257 @@
+-----------------------------------------------------------------------------
+-- $Id: GenUtils.lhs,v 1.1 1999/11/12 11:54:17 simonmar Exp $
+
+-- Some General Utilities, including sorts, etc.
+-- This is realy just an extended prelude.
+-- All the code below is understood to be in the public domain.
+-----------------------------------------------------------------------------
+
+> module GenUtils (
+
+>       partition', tack,
+>       assocMaybeErr,
+>       arrElem,
+>       memoise,
+>       returnMaybe,handleMaybe, findJust,
+>       MaybeErr(..),
+>       maybeMap,
+>       joinMaybe,
+>       mkClosure,
+>       foldb,
+>       sortWith,
+>       sort,
+>       cjustify,
+>       ljustify,
+>       rjustify,
+>       space,
+>       copy,
+>       combinePairs,
+>       --trace,                -- re-export it
+>       fst3,
+>       snd3,
+>       thd3
+
+#if __HASKELL1__ < 3 || ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 200 )
+
+>       ,Cmp(..), compare, lookup, isJust
+
+#endif
+
+>        ) where
+
+#if __HASKELL1__ >= 3 && ( !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ >= 200 )
+
+> import Ix    ( Ix(..) )
+> import Array ( listArray, array, (!) )
+
+#define Text Show
+#define ASSOC(a,b) (a , b)
+#else
+#define ASSOC(a,b) (a := b)
+#endif
+
+%------------------------------------------------------------------------------
+
+Here are two defs that everyone seems to define ...
+HBC has it in one of its builtin modules
+
+#ifdef __GOFER__
+
+ primitive primPrint "primPrint" :: Int -> a -> ShowS
+
+#endif
+
+#ifdef __GOFER__
+
+ primitive primGenericEq "primGenericEq",
+           primGenericNe "primGenericNe",
+           primGenericLe "primGenericLe",
+           primGenericLt "primGenericLt",
+           primGenericGe "primGenericGe",
+           primGenericGt "primGenericGt"   :: a -> a -> Bool
+
+ instance Text (Maybe a) where { showsPrec = primPrint }
+ instance Eq (Maybe a) where
+       (==) = primGenericEq
+       (/=) = primGenericNe
+
+ instance (Ord a) => Ord (Maybe a)
+   where
+       Nothing  <=  _       = True
+       _        <=  Nothing = True
+       (Just a) <= (Just b) = a <= b
+
+#endif
+
+> maybeMap :: (a -> b) -> Maybe a -> Maybe b
+> maybeMap f (Just a) = Just (f a)
+> maybeMap _ Nothing  = Nothing
+
+> joinMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
+> joinMaybe _ Nothing  Nothing  = Nothing
+> joinMaybe _ (Just g) Nothing  = Just g
+> joinMaybe _ Nothing  (Just g) = Just g
+> joinMaybe f (Just g) (Just h) = Just (f g h)
+
+> data MaybeErr a err = Succeeded a | Failed err deriving (Eq,Text)
+
+@mkClosure@ makes a closure, when given a comparison and iteration loop.
+Be careful, because if the functional always makes the object different,
+This will never terminate.
+
+> mkClosure :: (a -> a -> Bool) -> (a -> a) -> a -> a
+> mkClosure eq f = match . iterate f
+>   where
+>       match (a:b:_) | a `eq` b = a
+>       match (_:c)              = match c
+>       match [] = error "GenUtils.mkClosure: Can't happen"
+
+> foldb :: (a -> a -> a) -> [a] -> a
+> foldb _ [] = error "can't reduce an empty list using foldb"
+> foldb _ [x] = x
+> foldb f l  = foldb f (foldb' l)
+>    where
+>       foldb' (x:y:x':y':xs) = f (f x y) (f x' y') : foldb' xs
+>       foldb' (x:y:xs) = f x y : foldb' xs
+>       foldb' xs = xs
+
+Merge two ordered lists into one ordered list.
+
+> mergeWith               :: (a -> a -> Bool) -> [a] -> [a] -> [a]
+> mergeWith _ []     ys      = ys
+> mergeWith _ xs     []      = xs
+> mergeWith le (x:xs) (y:ys)
+>        | x `le` y  = x : mergeWith le xs (y:ys)
+>        | otherwise = y : mergeWith le (x:xs) ys
+
+> insertWith              :: (a -> a -> Bool) -> a -> [a] -> [a]
+> insertWith _ x []          = [x]
+> insertWith le x (y:ys)
+>        | x `le` y     = x:y:ys
+>        | otherwise    = y:insertWith le x ys
+
+Sorting is something almost every program needs, and this is the
+quickest sorting function I know of.
+
+> sortWith :: (a -> a -> Bool) -> [a] -> [a]
+> sortWith _ [] = []
+> sortWith le lst = foldb (mergeWith le) (splitList lst)
+>   where
+>       splitList (a1:a2:a3:a4:a5:xs) =
+>                insertWith le a1
+>               (insertWith le a2
+>               (insertWith le a3
+>               (insertWith le a4 [a5]))) : splitList xs
+>       splitList [] = []
+>       splitList (r:rs) = [foldr (insertWith le) [r] rs]
+
+> sort :: (Ord a) => [a] -> [a]
+> sort = sortWith (<=)
+
+> returnMaybe :: a -> Maybe a
+> returnMaybe = Just
+
+> handleMaybe :: Maybe a -> Maybe a -> Maybe a
+> handleMaybe m k = case m of
+>                Nothing -> k
+>                _ -> m
+
+> findJust :: (a -> Maybe b) -> [a] -> Maybe b
+> findJust f = foldr handleMaybe Nothing . map f
+
+
+Gofer-like stuff:
+
+> fst3 :: (a, b, c) -> a
+> fst3 (a, _, _) = a
+> snd3 :: (a, b, c) -> b
+> snd3 (_, a, _) = a
+> thd3 :: (a, b, c) -> c
+> thd3 (_, _, a) = a
+
+> cjustify, ljustify, rjustify :: Int -> String -> String
+> cjustify n s = space halfm ++ s ++ space (m - halfm)
+>                where m     = n - length s
+>                      halfm = m `div` 2
+> ljustify n s = s ++ space (n - length s)
+> rjustify n s = let s' = take n s in space (n - length s') ++ s'
+
+> space       :: Int -> String
+> space n | n < 0 = ""
+>         | otherwise = copy n ' '
+
+> copy  :: Int -> a -> [a]      -- make list of n copies of x
+> copy n x = take n xs where xs = x:xs
+
+> partition' :: (Eq b) => (a -> b) -> [a] -> [[a]]
+> partition' _ [] = []
+> partition' _ [x] = [[x]]
+> partition' f (x:x':xs) | f x == f x'
+>    = tack x (partition' f (x':xs))
+>                       | otherwise
+>    = [x] : partition' f (x':xs)
+
+> tack :: a -> [[a]] -> [[a]]
+> tack x xss = (x : head xss) : tail xss
+
+> combinePairs :: (Ord a) => [(a,b)] -> [(a,[b])]
+> combinePairs xs =
+>       combine [ (a,[b]) | (a,b) <- sortWith (\ (a,_) (b,_) -> a <= b) xs]
+>  where
+>       combine [] = []
+>       combine ((a,b):(c,d):r) | a == c = combine ((a,b++d) : r)
+>       combine (a:r) = a : combine r
+>
+
+#if __HASKELL1__ < 3 || ( defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 200 )
+
+> lookup :: (Eq a) => a -> [(a,b)] -> Maybe b
+> lookup k env = case [ val | (key,val) <- env, k == key] of
+>                [] -> Nothing
+>                (val:vs) -> Just val
+>
+
+> data Cmp = LT | EQ | GT
+
+> compare a b | a <  b    = LT
+>             | a == b    = EQ
+>             | otherwise = GT
+
+> isJust :: Maybe a -> Bool
+> isJust (Just _) = True
+> isJust _        = False
+
+#endif
+
+> assocMaybeErr :: (Eq a) => [(a,b)] -> a -> MaybeErr b String
+> assocMaybeErr env k = case [ val | (key,val) <- env, k == key] of
+>                        [] -> Failed "assoc: "
+>                        (val:_) -> Succeeded val
+
+Now some utilties involving arrays.
+Here is a version of @elem@ that uses partual application
+to optimise lookup.
+
+> arrElem :: (Ix a) => [a] -> a -> Bool
+> arrElem obj = \x -> inRange size x && arr ! x
+>   where
+>       obj' = sort obj
+>       size = (head obj',last obj')
+>       arr = listArray size [ i `elem` obj | i <- range size ]
+
+
+You can use this function to simulate memoisation. For example:
+
+      > fib = memoise (0,100) fib'
+      >   where
+      >       fib' 0 = 0
+      >       fib' 1 = 0
+      >       fib' n = fib (n-1) + fib (n-2)
+
+will give a very efficent variation of the fib function.
+
+
+> memoise :: (Ix a) => (a,a) -> (a -> b) -> a -> b
+> memoise bds f = (!) arr
+>   where arr = array bds [ ASSOC(t, f t) | t <- range bds ]
+
diff --git a/nofib-analyse/Main.hs b/nofib-analyse/Main.hs
new file mode 100644 (file)
index 0000000..7bcdd58
--- /dev/null
@@ -0,0 +1,911 @@
+-----------------------------------------------------------------------------
+-- $Id: Main.hs,v 1.10 2005/06/07 10:58:31 simonmar Exp $
+
+-- (c) Simon Marlow 1997-2005
+-----------------------------------------------------------------------------
+
+module Main where
+
+import GenUtils
+import Slurp
+import CmdLine
+
+import Text.Printf
+import Text.Html hiding (cols, rows, (!))
+import qualified Text.Html as Html ((!))
+import qualified Data.Map as Map
+import Data.Map (Map)
+import System.Exit      ( exitWith, ExitCode(..) )
+
+import Control.Monad
+import Data.Maybe       ( isNothing )
+import Data.Char
+import System.IO
+import Data.List
+
+(<!) :: Text.Html.ADDATTRS a => a -> [HtmlAttr] -> a
+(<!) = (Html.!)
+
+-----------------------------------------------------------------------------
+-- Top level stuff
+
+die :: String -> IO a
+die s = hPutStr stderr s >> exitWith (ExitFailure 1)
+
+data Normalise = NormalisePercent | NormaliseRatio | NormaliseNone
+
+main :: IO ()
+main = do
+
+ when (not (null cmdline_errors) || OptHelp `elem` flags) $
+      die (concat cmdline_errors ++ usage)
+
+ norm <- case [ n | OptNormalise n <- flags ] of
+                 []          -> return NormalisePercent
+                 ["percent"] -> return NormalisePercent
+                 ["ratio"]   -> return NormaliseRatio
+                 ["none"]    -> return NormaliseNone
+                 _           -> die ("unrecognised value for --normalise\n" ++ usage)
+
+ let { html  = OptHTMLOutput  `elem` flags;
+       latex = [ t | OptLaTeXOutput t <- flags ];
+       ascii = OptASCIIOutput `elem` flags;
+       csv   = [ t | OptCSV t <- flags ];
+     }
+
+ when (ascii && html)  $ die "Can't produce both ASCII and HTML"
+ when (devs && nodevs) $ die "Can't both display and hide deviations"
+
+ results <- parse_logs other_args
+
+ summary_spec <- case [ cols | OptColumns cols <- flags ] of
+                        []       -> return (pickSummary results)
+                        (cols:_) -> namedColumns (split ',' cols)
+
+ let summary_rows = case [ rows | OptRows rows <- flags ] of
+                        [] -> Nothing
+                        rows -> Just (split ',' (last rows))
+
+ let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
+
+ -- sanity check
+ sequence_ [ checkTimes prog res | result_table <- results,
+                                   (prog,res) <- Map.toList result_table ]
+
+ case () of
+   _ | not (null csv) ->
+        putStr (csvTable results (head csv) norm)
+   _ | html      ->
+        putStr (renderHtml (htmlPage results column_headings))
+   _ | not (null latex) ->
+        putStr (latexOutput results (head latex) column_headings summary_spec summary_rows norm)
+   _ | otherwise ->
+        putStr (asciiPage results column_headings summary_spec summary_rows norm)
+
+
+parse_logs :: [String] -> IO [ResultTable]
+parse_logs [] = do
+        f <- hGetContents stdin
+        return [parse_log f]
+parse_logs log_files =
+        mapM (\f -> do h <- openFile f ReadMode
+                       c <- hGetContents h
+                       return (parse_log c)) log_files
+
+-----------------------------------------------------------------------------
+-- List of tables we're going to generate
+
+data PerProgTableSpec =
+        forall a . Result a =>
+           SpecP
+                String                  -- Name of the table
+                String                  -- Short name (for column heading)
+                String                  -- HTML tag for the table
+                (Results -> Maybe a)    -- How to get the result
+                (Results -> Status)     -- How to get the status of this result
+                (a -> Bool)             -- Result within reasonable limits?
+
+data PerModuleTableSpec =
+        forall a . Result a =>
+           SpecM
+                String                  -- Name of the table
+                String                  -- HTML tag for the table
+                (Results -> Map String a)       -- get the module map
+                (a -> Bool)             -- Result within reasonable limits?
+
+-- The various per-program aspects of execution that we can generate results for.
+size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec,
+    gctime_spec, gcelap_spec,
+    gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec,
+    gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec, balance_spec
+        :: PerProgTableSpec
+size_spec    = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
+alloc_spec   = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok
+runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok
+elapsedtime_spec = SpecP "Elapsed Time" "Elapsed" "elapsed-times" (mean elapsed_time) run_status time_ok
+muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok
+mutetime_spec = SpecP "Mutator Elapsed Time" "MutETime" "mutator-elapsed-time" (mean mut_elapsed_time) run_status time_ok
+gctime_spec  = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok
+gcelap_spec  = SpecP "GC Elapsed Time" "GCETime" "gc-elapsed-time" (mean gc_elapsed_time) run_status time_ok
+gc0time_spec  = SpecP "GC(0) Time" "GC0Time" "gc0-time" (mean gc0_time) run_status time_ok
+gc0elap_spec  = SpecP "GC(0) Elapsed Time" "GC0ETime" "gc0-elapsed-time" (mean gc0_elapsed_time) run_status time_ok
+gc1time_spec  = SpecP "GC(1) Time" "GC1Time" "gc1-time" (mean gc1_time) run_status time_ok
+gc1elap_spec  = SpecP "GC(1) Elapsed Time" "GC1ETime" "gc1-elapsed-time" (mean gc1_elapsed_time) run_status time_ok
+balance_spec  = SpecP "GC work balance" "Balance" "balance" (mean balance) run_status time_ok
+gcwork_spec  = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok
+instrs_spec  = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
+mreads_spec  = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
+mwrite_spec  = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok
+cmiss_spec   = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok
+
+all_specs :: [PerProgTableSpec]
+all_specs = [
+  size_spec,
+  alloc_spec,
+  runtime_spec,
+  elapsedtime_spec,
+  muttime_spec,
+  mutetime_spec,
+  gctime_spec,
+  gcelap_spec,
+  gc0time_spec,
+  gc0elap_spec,
+  gc1time_spec,
+  gc1elap_spec,
+  balance_spec,
+  gcwork_spec,
+  instrs_spec,
+  mreads_spec,
+  mwrite_spec,
+  cmiss_spec
+  ]
+
+namedColumns :: [String] -> IO [PerProgTableSpec]
+namedColumns ss = mapM findSpec ss
+  where findSpec s =
+           case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
+                         short_name == s ] of
+                [] -> die ("unknown column: " ++ s)
+                (spec:_) -> return spec
+
+mean :: (Results -> [Float]) -> Results -> Maybe Float
+mean f results = go (f results)
+  where go [] = Nothing
+        go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs))
+
+-- Look for bogus-looking times: On Linux we occasionally get timing results
+-- that are bizarrely low, and skew the average.
+checkTimes :: String -> Results -> IO ()
+checkTimes prog results = do
+  check "run time" (run_time results)
+  check "mut time" (mut_time results)
+  check "GC time" (gc_time results)
+  where
+        check kind ts
+           | any strange ts =
+                hPutStrLn stderr ("warning: dubious " ++ kind
+                                   ++ " results for " ++ prog
+                                   ++ ": " ++ show ts)
+           | otherwise = return ()
+           where strange t = any (\r -> time_ok r && r / t > 1.4) ts
+                        -- looks for times that are >40% smaller than
+                        -- any other.
+
+
+-- These are the per-prog tables we want to generate
+per_prog_result_tab :: [PerProgTableSpec]
+per_prog_result_tab =
+        [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec, gctime_spec,
+          gcelap_spec, gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec,
+          gcwork_spec, balance_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec]
+
+-- A single summary table, giving comparison figures for a number of
+-- aspects, each in its own column.  Only works when comparing two runs.
+normal_summary_specs :: [PerProgTableSpec]
+normal_summary_specs =
+        [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec ]
+
+cachegrind_summary_specs :: [PerProgTableSpec]
+cachegrind_summary_specs =
+        [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
+
+-- Pick an appropriate summary table: if we're cachegrinding, then
+-- we're probably not interested in the runtime, but we are interested
+-- in instructions, mem reads and mem writes (and vice-versa).
+pickSummary :: [ResultTable] -> [PerProgTableSpec]
+pickSummary rs
+  | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
+  | otherwise = cachegrind_summary_specs
+
+per_module_result_tab :: [PerModuleTableSpec]
+per_module_result_tab =
+        [ SpecM "Module Sizes"  "mod-sizes"     module_size  always_ok
+        , SpecM "Compile Times" "compile-time"  compile_time time_ok
+        ]
+
+always_ok :: a -> Bool
+always_ok = const True
+
+time_ok :: Float -> Bool
+time_ok t = t > tooquick_threshold
+
+-----------------------------------------------------------------------------
+-- HTML page generation
+
+htmlPage :: [ResultTable] -> [String] -> Html
+htmlPage results args
+   =  header << thetitle << reportTitle
+          +++ hr
+          +++ h1 << reportTitle
+          +++ gen_menu
+          +++ hr
+          +++ body (gen_tables results args)
+
+gen_menu :: Html
+gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
+                   ++ map (module_menu_item) per_module_result_tab)
+
+prog_menu_item :: PerProgTableSpec -> Html
+prog_menu_item (SpecP long_name _ anc _ _ _)
+    = anchor <! [href ('#':anc)] << long_name
+module_menu_item :: PerModuleTableSpec -> Html
+module_menu_item (SpecM long_name anc _ _)
+    = anchor <! [href ('#':anc)] << long_name
+
+gen_tables :: [ResultTable] -> [String] -> Html
+gen_tables results args =
+      foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
+  +++ foldr1 (+++) (map (htmlGenModTable  results args) per_module_result_tab)
+
+htmlGenProgTable :: [ResultTable] -> [String] -> PerProgTableSpec -> Html
+htmlGenProgTable results args (SpecP long_name _ anc get_result get_status result_ok)
+  =   sectHeading long_name anc
+  +++ font <! [size "1"]
+        << mkTable (htmlShowResults results args get_result get_status result_ok)
+  +++ hr
+
+htmlGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> Html
+htmlGenModTable results args (SpecM long_name anc get_result result_ok)
+  =   sectHeading long_name anc
+  +++ font <![size "1"]
+        << mkTable (htmlShowMultiResults results args get_result result_ok)
+  +++ hr
+
+sectHeading :: String -> String -> Html
+sectHeading s nm = h2 << anchor <! [name nm] << s
+
+htmlShowResults
+    :: Result a
+        => [ResultTable]
+        -> [String]
+        -> (Results -> Maybe a)
+        -> (Results -> Status)
+        -> (a -> Bool)
+        -> HtmlTable
+
+htmlShowResults []     _  _  _   _
+ = error "htmlShowResults: Can't happen?"
+htmlShowResults (r:rs) ss f stat result_ok
+  =   tabHeader ss
+  </> aboves (zipWith tableRow [1..] results_per_prog)
+  </> aboves ((if nodevs then []
+                         else [tableRow (-1) ("-1 s.d.", lows),
+                               tableRow (-1) ("+1 s.d.", highs)])
+                    ++ [tableRow (-1) ("Average", gms)])
+ where
+        -- results_per_prog :: [ (String,[BoxValue a]) ]
+        results_per_prog = map (calc_result rs f stat result_ok convert_to_percentage) (Map.toList r)
+
+        results_per_run  = transpose (map snd results_per_prog)
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
+
+htmlShowMultiResults
+    :: Result a
+        => [ResultTable]
+        -> [String]
+        -> (Results -> Map String a)
+        -> (a -> Bool)
+        -> HtmlTable
+
+htmlShowMultiResults []     _  _ _
+ = error "htmlShowMultiResults: Can't happen?"
+htmlShowMultiResults (r:rs) ss f result_ok =
+        multiTabHeader ss
+         </> aboves (map show_results_for_prog results_per_prog_mod_run)
+         </> aboves ((if nodevs then []
+                                      else [td << bold << "-1 s.d."
+                                            <-> tableRow (-1) ("", lows),
+                                            td << bold << "+1 s.d."
+                                            <-> tableRow (-1) ("", highs)])
+                           ++ [td << bold << "Average"
+                               <-> tableRow (-1) ("", gms)])
+  where
+        base_results = Map.toList r :: [(String,Results)]
+
+        -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
+        results_per_prog_mod_run = map get_results_for_prog base_results
+
+        -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
+        get_results_for_prog (prog, results)
+            = (prog, map get_results_for_mod (Map.toList (f results)))
+
+           where fms = map get_run_results rs
+
+                 get_run_results fm = case Map.lookup prog fm of
+                                        Nothing  -> Map.empty
+                                        Just res -> f res
+
+                 get_results_for_mod id_attr
+                     = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
+
+        show_results_for_prog (prog,mrs) =
+            td <! [valign "top"] << bold << prog
+            <-> (if null mrs then
+                   td << "(no modules compiled)"
+                 else
+                   toHtml (aboves (map (tableRow 0) mrs)))
+
+        results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
+                                           (_,xs) <- mods]
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
+
+tableRow :: Int -> (String, [BoxValue]) -> HtmlTable
+tableRow row_no (prog, results)
+        =   td <! [bgcolor left_column_color] << prog
+        <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
+                                results)
+  where clr | row_no < 0  = bgcolor average_row_color
+            | even row_no = bgcolor even_row_color
+            | otherwise   = bgcolor odd_row_color
+
+left_column_color, odd_row_color, even_row_color, average_row_color :: String
+left_column_color = "#d0d0ff"  -- light blue
+odd_row_color     = "#d0d0ff"  -- light blue
+even_row_color    = "#f0f0ff"  -- v. light blue
+average_row_color = "#ffd0d0"  -- light red
+
+{-
+findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
+findBest stuff@(Result base : rest)
+  = map (\a -> (a==base, a))
+  where
+        best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
+
+        no_pcnt_stuff = map unPcnt stuff
+
+        unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
+        unPcnt (r@(Result a) : rest)     = (a, r) : unPcnt rest
+        unPcnt (_ : rest)                = unPcnt rest
+-}
+
+logHeaders :: [String] -> HtmlTable
+logHeaders ss
+  = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
+
+mkTable :: HtmlTable -> Html
+mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
+
+tabHeader :: [String] -> HtmlTable
+tabHeader ss
+  =   (td <! [align "left", width "100"] << bold << "Program")
+  <-> logHeaders ss
+
+multiTabHeader :: [String] -> HtmlTable
+multiTabHeader ss
+  =   (td <! [align "left", width "100"] << bold << "Program")
+  <-> (td <! [align "left", width "100"] << bold << "Module")
+  <-> logHeaders ss
+
+-- Calculate a color ranging from bright blue for -100% to bright red for +100%.
+calcColor :: Int -> String
+calcColor percentage | percentage >= 0 = printf "#%02x0000" val
+                     | otherwise       = printf "#0000%02x" val
+        where val = abs percentage * 255 `div` 100
+
+-----------------------------------------------------------------------------
+-- LaTeX table generation (just the summary for now)
+
+latexOutput :: [ResultTable] -> Maybe String -> [String] -> [PerProgTableSpec]
+            -> Maybe [String] -> Normalise ->  String
+
+latexOutput results (Just table_name) _ _ _ norm
+  = let
+        table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab, 
+                       n == table_name ]
+    in
+    case table_spec of
+        [] -> error ("can't find table named: " ++ table_name)
+        (spec:_) -> latexProgTable results spec norm "\n"
+
+latexOutput results Nothing _ summary_spec summary_rows _ =
+   (if (length results == 2)
+        then ascii_summary_table True results summary_spec summary_rows
+            . str "\n\n"
+        else id) ""
+
+
+latexProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> ShowS
+latexProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm
+  = latex_show_results results get_result get_status result_ok norm
+
+latex_show_results
+   :: Result a
+        => [ResultTable]
+        -> (Results -> Maybe a)
+        -> (Results -> Status)
+        -> (a -> Bool)
+        -> Normalise
+        -> ShowS
+
+latex_show_results []      _ _    _ _
+ = error "latex_show_results: Can't happen?"
+latex_show_results (r:rs) f stat _result_ok norm
+        = makeLatexTable $
+             [ TableRow (BoxString prog : boxes) | 
+               (prog,boxes) <- results_per_prog ] ++
+             if nodevs then [] else
+             [ TableLine,
+               TableRow (BoxString "Min" : mins),
+               TableRow (BoxString "Max" : maxs),
+               TableRow (BoxString "Geometric Mean" : gms) ]
+ where
+        -- results_per_prog :: [ (String,[BoxValue a]) ]
+        results_per_prog = [ (prog,tail xs) | (prog,xs) <- map calc (Map.toList r) ]
+        calc = calc_result rs f stat (const True) (normalise norm)
+
+        results_per_run    = transpose (map snd results_per_prog)
+        (_lows,gms,_highs) = unzip3 (map calc_gmsd results_per_run)
+        (mins, maxs)       = unzip  (map calc_minmax results_per_run)
+
+normalise :: Result a => Normalise -> a -> a -> BoxValue 
+normalise norm = case norm of
+             NormalisePercent -> convert_to_percentage
+             NormaliseRatio   -> normalise_to_base
+             NormaliseNone    -> \_base res -> toBox res
+
+-----------------------------------------------------------------------------
+-- ASCII page generation
+
+asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String]
+          -> Normalise
+          -> String
+asciiPage results args summary_spec summary_rows norm =
+  ( str reportTitle
+  . str "\n\n"
+     -- only show the summary table if we're comparing two runs
+  . (if (length results == 2)
+        then ascii_summary_table False results summary_spec summary_rows . str "\n\n"
+        else id)
+  . interleave "\n\n" (map (asciiGenProgTable results args norm) per_prog_result_tab)
+  . str "\n"
+  . interleave "\n\n" (map (asciiGenModTable results args)  per_module_result_tab)
+  ) "\n"
+
+asciiGenProgTable :: [ResultTable] -> [String] -> Normalise -> PerProgTableSpec -> ShowS
+asciiGenProgTable results args norm (SpecP long_name _ _ get_result get_status result_ok)
+  = str long_name
+  . str "\n"
+  . ascii_show_results results args get_result get_status result_ok norm
+
+asciiGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> ShowS
+asciiGenModTable results args (SpecM long_name _ get_result result_ok)
+  = str long_name
+  . str "\n"
+  . ascii_show_multi_results results args get_result result_ok
+
+ascii_header :: Int -> [String] -> ShowS
+ascii_header w ss
+        = str "\n-------------------------------------------------------------------------------\n"
+        . str (rjustify 15 "Program")
+        . str (space 5)
+        . foldr (.) id (map (str . rjustify w) ss)
+        . str "\n-------------------------------------------------------------------------------\n"
+
+ascii_show_results
+   :: Result a
+        => [ResultTable]
+        -> [String]
+        -> (Results -> Maybe a)
+        -> (Results -> Status)
+        -> (a -> Bool)
+        -> Normalise
+        -> ShowS
+
+ascii_show_results []     _  _ _    _ _
+ = error "ascii_show_results: Can't happen?"
+ascii_show_results (r:rs) ss f stat result_ok norm
+        = ascii_header fIELD_WIDTH ss
+        . interleave "\n" (map show_per_prog_results results_per_prog)
+        . if nodevs then id
+                    else   str "\n"
+                         . show_per_prog_results ("-1 s.d.",lows)
+                         . str "\n"
+                         . show_per_prog_results ("+1 s.d.",highs)
+        . str "\n"
+        . show_per_prog_results ("Average",gms)
+ where
+        -- results_per_prog :: [ (String,[BoxValue a]) ]
+        results_per_prog = map (calc_result rs f stat result_ok (normalise norm)) (Map.toList r)
+
+        results_per_run  = transpose (map snd results_per_prog)
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
+
+-- A summary table, useful only when we are comparing two runs.  This table
+-- shows a number of different result categories, one per column.
+ascii_summary_table
+        :: Bool                         -- generate a LaTeX table?
+        -> [ResultTable]
+        -> [PerProgTableSpec]
+        -> Maybe [String]
+        -> ShowS
+ascii_summary_table _     []        _     _
+ = error "ascii_summary_table: Can't happen?"
+ascii_summary_table _     [_]       _     _
+ = error "ascii_summary_table: Can't happen?"
+ascii_summary_table latex (r1:r2:_) specs mb_restrict
+  | latex     = makeLatexTable (rows ++ TableLine : av_rows)
+  | otherwise =
+       makeTable (table_layout (length specs) w)
+          (TableLine : TableRow header_row :
+           TableLine : rows ++
+           TableLine : av_rows)
+  where
+        header_row = BoxString "Program" : map BoxString headings
+
+        (headings, columns, av_cols) = unzip3 (map calc_col specs)
+        av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]
+        baseline = Map.toList r1
+        progs   = map BoxString (Map.keys r1)
+        rows0   = map TableRow (zipWith (:) progs (transpose columns))
+
+        rows1 = restrictRows mb_restrict rows0
+
+        rows | latex     = mungeForLaTeX rows1
+             | otherwise = rows1
+
+        av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
+        w   = 10
+
+        calc_col (SpecP _ heading _ getr gets ok)
+            -- throw away the baseline result
+          = (heading, column, [column_min, column_max, column_mean])
+          where (_, boxes) = unzip (map calc_one_result baseline)
+                calc_one_result = calc_result [r2] getr gets ok convert_to_percentage
+                column = map (\(_:b:_) -> b) boxes
+                (_, column_mean, _) = calc_gmsd column
+                (column_min, column_max) = calc_minmax column
+
+restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
+restrictRows Nothing rows = rows
+restrictRows (Just these) rows = filter keep_it rows
+  where keep_it (TableRow (BoxString s: _)) = s `elem` these
+        keep_it TableLine = True
+        keep_it _ = False
+
+mungeForLaTeX :: [TableRow] -> [TableRow]
+mungeForLaTeX = map transrow
+   where
+        transrow (TableRow boxes) = TableRow (map transbox boxes)
+        transrow row = row
+
+        transbox (BoxString s) = BoxString (foldr transchar "" s)
+        transbox box = box
+
+        transchar '_' s = '\\':'_':s
+        transchar c s = c:s
+
+table_layout :: Int -> Int -> Layout
+table_layout n w boxes = foldr (.) id $ zipWith ($) fns boxes
+ where fns = (str . rjustify 15 . show ) :
+             (\s -> str (space 5) . str (rjustify w (show s))) :
+             replicate (n-1) (str . rjustify w . show)
+
+ascii_show_multi_results
+   :: Result a
+        => [ResultTable]
+        -> [String]
+        -> (Results -> Map String a)
+        -> (a -> Bool)
+        -> ShowS
+
+ascii_show_multi_results []     _  _ _
+ = error "ascii_show_multi_results: Can't happen?"
+ascii_show_multi_results (r:rs) ss f result_ok
+        = ascii_header fIELD_WIDTH ss
+        . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
+        . str "\n"
+        . if nodevs then id
+                    else   str "\n"
+                         . show_per_prog_results ("-1 s.d.",lows)
+                         . str "\n"
+                         . show_per_prog_results ("+1 s.d.",highs)
+        . str "\n"
+        . show_per_prog_results ("Average",gms)
+  where
+        base_results = Map.toList r :: [(String,Results)]
+
+        -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
+        results_per_prog_mod_run = map get_results_for_prog base_results
+
+        -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
+        get_results_for_prog (prog, results)
+            = (prog, map get_results_for_mod (Map.toList (f results)))
+
+           where fms = map get_run_results rs
+
+                 get_run_results fm = case Map.lookup prog fm of
+                                        Nothing  -> Map.empty
+                                        Just res -> f res
+
+                 get_results_for_mod id_attr
+                     = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
+
+        show_results_for_prog (prog,mrs) =
+              str ("\n"++prog++"\n")
+            . (if null mrs then
+                   str "(no modules compiled)\n"
+                 else
+                   interleave "\n" (map show_per_prog_results mrs))
+
+        results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
+                                           (_,xs) <- mods]
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
+
+
+show_per_prog_results :: (String, [BoxValue]) -> ShowS
+show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
+
+show_per_prog_results_width :: Int -> (String, [BoxValue]) -> ShowS
+show_per_prog_results_width w (prog,results)
+        = str (rjustify 15 prog)
+        . str (space 5)
+        . foldr (.) id (map (str . rjustify w . showBox) results)
+
+-- -----------------------------------------------------------------------------
+-- CSV output
+
+csvTable :: [ResultTable] -> String -> Normalise -> String
+csvTable results table_name norm
+  = let
+        table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab, 
+                       n == table_name ]
+    in
+    case table_spec of
+        [] -> error ("can't find table named: " ++ table_name)
+        (spec:_) -> csvProgTable results spec norm "\n"
+
+csvProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> ShowS
+csvProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm
+  = csv_show_results results get_result get_status result_ok norm
+
+csv_show_results
+   :: Result a
+        => [ResultTable]
+        -> (Results -> Maybe a)
+        -> (Results -> Status)
+        -> (a -> Bool)
+        -> Normalise
+        -> ShowS
+
+csv_show_results []      _ _    _ _
+ = error "csv_show_results: Can't happen?"
+csv_show_results (r:rs) f stat _result_ok norm
+        = interleave "\n" results_per_prog
+ where
+        -- results_per_prog :: [ (String,[BoxValue a]) ]
+        results_per_prog = map (result_line . calc) (Map.toList r)
+        calc = calc_result rs f stat (const True) (normalise norm)
+
+        result_line (prog,boxes) = interleave "," (str prog : map (str.showBox) boxes)
+
+-- ---------------------------------------------------------------------------
+-- Generic stuff for results generation
+
+-- calc_result is a nice exercise in higher-order programming...
+calc_result
+  :: Result a
+        => [Map String b]               -- accumulated results
+        -> (b -> Maybe a)               -- get a result from the b
+        -> (b -> Status)                -- get a status from the b
+        -> (a -> Bool)                  -- normalise against the baseline?
+        -> (a -> a -> BoxValue)             -- how to normalise
+        -> (String,b)                   -- the baseline result
+        -> (String,[BoxValue])
+
+calc_result rts get_maybe_a get_stat base_ok norm_fn (prog,base_r) =
+        (prog, (just_result m_baseline base_stat :
+
+          let
+                rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
+
+                get_stuff Nothing  = (Nothing, NotDone)
+                get_stuff (Just r) = (get_maybe_a r, get_stat r)
+          in
+          (
+          case m_baseline of
+             Just baseline | base_ok baseline
+                 -> map (\(r,s) -> do_norm r s baseline) rts'
+             _other
+                 -> map (\(r,s) -> just_result r s) rts'
+           )))
+ where
+        m_baseline  = get_maybe_a base_r
+        base_stat = get_stat base_r
+
+        just_result Nothing  s = RunFailed s
+        just_result (Just a) _ = toBox a
+
+        do_norm Nothing   s _        = RunFailed s
+        do_norm (Just a)  _ baseline = norm_fn baseline a
+
+-----------------------------------------------------------------------------
+-- Calculating geometric means and standard deviations
+
+{-
+This is done using the log method, to avoid needing really large
+intermediate results.  The formula for a geometric mean is
+
+        (a1 * .... * an) ^ 1/n
+
+which is equivalent to
+
+        e ^ ( (log a1 + ... + log an) / n )
+
+where log is the natural logarithm function.
+
+Similarly, to compute the geometric standard deviation we compute the
+deviation of each log, take the root-mean-square, and take the
+exponential again:
+
+        e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
+
+where lbar is the mean log,
+
+        (log a1 + ... + log an) / n
+
+This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
+not subtract 100 from gm before performing this calculation.
+
+We therefore return a (low, mean, high) triple.
+
+-}
+
+calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
+calc_gmsd xs
+  | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
+  | otherwise        = let sqr x   = x * x
+                           len     = fromIntegral (length percentages)
+                           logs    = map log percentages
+                           lbar    = sum logs / len
+                           st_devs = map (sqr . (lbar-)) logs
+                           dbar    = sum st_devs / len
+                           gm      = exp lbar
+                           sdf     = exp (sqrt dbar)
+                       in
+                       (Percentage (gm/sdf),
+                        Percentage gm,
+                        Percentage (gm*sdf))
+ where
+  percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
+        -- can't do log(0.0), so exclude zeros
+        -- small values have inordinate effects so cap at -95%.
+
+calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
+calc_minmax xs
+ | null percentages = (RunFailed NotDone, RunFailed NotDone)
+ | otherwise = (Percentage (minimum percentages),
+                Percentage (maximum percentages))
+ where
+  percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
+
+
+-----------------------------------------------------------------------------
+-- Show the Results
+
+convert_to_percentage :: Result a => a -> a -> BoxValue
+convert_to_percentage 0 _val = Percentage 100
+convert_to_percentage baseline val = Percentage  ((realToFrac val / realToFrac baseline) * 100)
+
+normalise_to_base :: Result a => a -> a -> BoxValue
+normalise_to_base 0 _val       = BoxFloat 1
+normalise_to_base baseline val = BoxFloat (realToFrac baseline / realToFrac val)
+
+class Real a => Result a where
+        toBox :: a -> BoxValue
+
+-- We assume an Int is a size, and print it in kilobytes.
+
+instance Result Int where
+    toBox = BoxInt
+
+instance Result Integer where
+    toBox = BoxInteger
+
+instance Result Float where
+    toBox = BoxFloat
+
+-- -----------------------------------------------------------------------------
+-- BoxValues
+
+-- The contents of a box in a table
+data BoxValue
+  = RunFailed Status
+  | Percentage Float
+  | BoxFloat Float
+  | BoxInt Int
+  | BoxInteger Integer
+  | BoxString String
+
+showBox :: BoxValue -> String
+showBox (RunFailed stat) = show_stat stat
+showBox (Percentage f)   = case printf "%.1f%%" (f-100) of
+                               xs@('-':_) -> xs
+                               xs -> '+':xs
+showBox (BoxFloat f)     = printf "%.2f" f
+showBox (BoxInt n)       = show (n `div` 1024) ++ "k"
+showBox (BoxInteger n)   = show (n `div` 1024) ++ "k"
+showBox (BoxString s)    = s
+
+instance Show BoxValue where
+    show = showBox
+
+show_stat :: Status -> String
+show_stat Success     = "(no result)"
+show_stat WrongStdout = "(stdout)"
+show_stat WrongStderr = "(stderr)"
+show_stat (Exit x)    = "exit(" ++ show x ++")"
+show_stat OutOfHeap   = "(heap)"
+show_stat OutOfStack  = "(stack)"
+show_stat NotDone     = "-----"
+
+-- -----------------------------------------------------------------------------
+-- Table layout
+
+data TableRow
+  = TableRow [BoxValue]
+  | TableLine
+
+type Layout = [BoxValue] -> ShowS
+
+makeTable :: Layout -> [TableRow] -> ShowS
+makeTable layout = interleave "\n" . map do_row
+  where do_row (TableRow boxes) = layout boxes
+        do_row TableLine = str (take 80 (repeat '-'))
+
+makeLatexTable :: [TableRow] -> ShowS
+makeLatexTable = foldr (.) id . map do_row
+  where do_row (TableRow boxes)
+           = latexTableLayout boxes . str "\\\\\n"
+        do_row TableLine
+           = str "\\hline\n"
+
+latexTableLayout :: Layout
+latexTableLayout boxes = 
+  foldr (.) id . intersperse (str " & ") . map abox $ boxes
+  where 
+        abox (RunFailed NotDone) = id
+        abox s = str (foldr transchar "" (show s))
+
+        transchar '%' s = s  -- leave out the percentage signs
+        transchar c   s = c : s
+
+-- -----------------------------------------------------------------------------
+-- General Utils
+
+split :: Char -> String -> [String]
+split c s = case break (==c) s of
+                (chunk, rest) ->
+                    case rest of
+                        []      -> [chunk]
+                        _:rest' -> chunk : split c rest'
+
+str :: String -> ShowS
+str = showString
+
+interleave :: String -> [ShowS] -> ShowS
+interleave s = foldr1 (\a b -> a . str s . b)
+
+fIELD_WIDTH :: Int
+fIELD_WIDTH = 16
+
+-----------------------------------------------------------------------------
diff --git a/nofib-analyse/Makefile b/nofib-analyse/Makefile
new file mode 100644 (file)
index 0000000..c9765aa
--- /dev/null
@@ -0,0 +1,17 @@
+TOP=..
+include $(TOP)/mk/boilerplate.mk
+
+PROG = nofib-analyse
+
+$(PROG):
+       $(GHC) -O -cpp -fglasgow-exts --make Main -o $(PROG)
+
+all :: $(PROG)
+
+boot :: $(PROG)
+
+clean:
+       rm -f $(PROG)
+       rm -f CmdLine.hi GenUtils.hi Main.hi Slurp.hi
+       rm -f CmdLine.o  GenUtils.o  Main.o  Slurp.o
+
diff --git a/nofib-analyse/Slurp.hs b/nofib-analyse/Slurp.hs
new file mode 100644 (file)
index 0000000..fc605c8
--- /dev/null
@@ -0,0 +1,467 @@
+-----------------------------------------------------------------------------
+--
+-- (c) Simon Marlow 1997-2005
+--
+-----------------------------------------------------------------------------
+
+module Slurp (Status(..), Results(..), ResultTable, parse_log) where
+
+import Control.Monad
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Text.Regex
+import Data.Maybe
+-- import Debug.Trace
+
+-----------------------------------------------------------------------------
+-- This is the structure into which we collect our results:
+
+type ResultTable = Map String Results
+
+data Status
+        = NotDone
+        | Success
+        | OutOfHeap
+        | OutOfStack
+        | Exit Int
+        | WrongStdout
+        | WrongStderr
+
+data Results = Results {
+        compile_time    :: Map String Float,
+        module_size     :: Map String Int,
+        binary_size     :: Maybe Int,
+        link_time       :: Maybe Float,
+        run_time        :: [Float],
+        elapsed_time    :: [Float],
+        mut_time        :: [Float],
+        mut_elapsed_time :: [Float],
+        instrs          :: Maybe Integer,
+        mem_reads       :: Maybe Integer,
+        mem_writes      :: Maybe Integer,
+        cache_misses    :: Maybe Integer,
+        gc_work         :: Maybe Integer,
+        gc_time         :: [Float],
+        gc_elapsed_time :: [Float],
+        gc0_time         :: [Float],
+        gc0_elapsed_time :: [Float],
+        gc1_time         :: [Float],
+        gc1_elapsed_time :: [Float],
+        balance         :: [Float],
+        allocs          :: Maybe Integer,
+        run_status      :: Status,
+        compile_status  :: Status
+        }
+
+emptyResults :: Results
+emptyResults = Results {
+        compile_time    = Map.empty,
+        module_size     = Map.empty,
+        binary_size     = Nothing,
+        link_time       = Nothing,
+        run_time        = [],
+        elapsed_time    = [],
+        mut_time        = [],
+        mut_elapsed_time = [],
+        instrs          = Nothing,
+        mem_reads       = Nothing,
+        mem_writes      = Nothing,
+        cache_misses    = Nothing,
+        gc_time         = [],
+        gc_elapsed_time = [],
+        gc0_time         = [],
+        gc0_elapsed_time = [],
+        gc1_time         = [],
+        gc1_elapsed_time = [],
+        balance         = [],
+        gc_work         = Nothing,
+        allocs          = Nothing,
+        compile_status  = NotDone,
+        run_status      = NotDone
+        }
+
+-----------------------------------------------------------------------------
+-- Parse the log file
+
+{-
+Various banner lines:
+
+==nofib== awards: size of QSort.o follows...
+==nofib== banner: size of banner follows...
+==nofib== awards: time to link awards follows...
+==nofib== awards: time to run awards follows...
+==nofib== boyer2: time to compile Checker follows...
+-}
+
+-- NB. the hyphen must come last (or first) inside [...] to stand for itself.
+banner_re :: Regex
+banner_re = mkRegex "^==nofib==[ \t]+([A-Za-z0-9_-]+):[ \t]+(size of|time to link|time to run|time to compile|time to compile & run)[ \t]+([A-Za-z0-9_-]+)(\\.o)?[ \t]+follows"
+
+{-
+This regexp for the output of "time" works on FreeBSD, other versions
+of "time" will need different regexps.
+-}
+
+time_re :: String -> Maybe (Float, Float, Float)
+time_re s = case matchRegex re s of
+                Just [real, user, system] ->
+                    Just (read real, read user, read system)
+                Just _ -> error "time_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
+
+time_gnu17_re :: String -> Maybe (Float, Float, String)
+time_gnu17_re s = case matchRegex re s of
+                      Just [user, system, elapsed] ->
+                          Just (read user, read system, elapsed)
+                      Just _ -> error "time_gnu17_re: Can't happen"
+                      Nothing -> Nothing
+    where re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
+          -- /usr/bin/time --version reports: GNU time 1.7
+          -- notice the order is different, and the elapsed time
+          -- is [hh:]mm:ss.s
+
+size_re :: String -> Maybe (Int, Int, Int)
+size_re s = case matchRegex re s of
+                Just [text, datas, bss] ->
+                    Just (read text, read datas, read bss)
+                Just _ -> error "size_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
+
+{-
+<<ghc: 5820820 bytes, 0 GCs, 0/0 avg/max bytes residency (0 samples), 41087234 bytes GC work, 0.00 INIT (0.05 elapsed), 0.08 MUT (0.18 elapsed), 0.00 GC (0.00 elapsed) :ghc>>
+
+        = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
+           init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
+
+ghc1_re = pre GHC 4.02
+ghc2_re = GHC 4.02 (includes "xxM in use")
+ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
+ghc5_re = GHC 6.9 (includes GC(0) and GC(1) times)
+-}
+
+ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
+ghc1_re s = case matchRegex re s of
+                Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
+                    Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed)
+                Just _ -> error "ghc1_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
+
+ghc2_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
+ghc2_re s = case matchRegex re s of
+                Just [allocations, gcs, avg_residency, max_residency, samples, in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
+                    Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed)
+                Just _ -> error "ghc2_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
+
+ghc3_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
+ghc3_re s = case matchRegex re s of
+                Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
+                    Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed)
+                Just _ -> error "ghc3_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
+
+ghc4_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float, Integer, Integer, Integer, Integer)
+ghc4_re s = case matchRegex re s of
+                Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed, instructions, memory_reads, memory_writes, l2_cache_misses] ->
+                    Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed, read instructions, read memory_reads, read memory_writes, read l2_cache_misses)
+                Just _ -> error "ghc4_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^<<ghc-instrs:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9]+) instructions, ([0-9]+) memory reads, ([0-9]+) memory writes, ([0-9]+) L2 cache misses :ghc-instrs>>"
+
+ghc5_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float,Float,Float,Float,Float,Float)
+ghc5_re s = case matchRegex re s of
+                Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed, gc0, gc0_elapsed, gc1, gc1_elapsed, bal] ->
+                    Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed, read gc0, read gc0_elapsed, read gc1, read gc1_elapsed, read bal)
+                Just _ -> error "ghc3_re: Can't happen"
+                Nothing -> Nothing
+    where re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9.]+) GC\\(0\\) \\(([0-9.]+) elapsed\\), ([0-9.]+) GC\\(1\\) \\(([0-9.]+) elapsed\\), ([0-9.]+) balance :ghc>>"
+
+wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex
+wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
+wrong_output      = mkRegex "^expected (stdout|stderr) not matched by reality$"
+out_of_heap       = mkRegex "^\\+ Heap exhausted;$"
+out_of_stack      = mkRegex "^\\+ Stack space overflow:"
+
+parse_log :: String -> ResultTable
+parse_log
+        = combine_results               -- collate information
+        . concat
+        . map process_chunk             -- get information from each chunk
+        . tail                          -- first chunk is junk
+        . chunk_log [] []               -- break at banner lines
+        . lines
+
+combine_results :: [(String,Results)] -> Map String Results
+combine_results = foldr f Map.empty
+ where
+        f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm
+
+combine2Results :: Results -> Results -> Results
+combine2Results
+             Results{ compile_time = ct1, link_time = lt1,
+                      module_size = ms1,
+                      run_time = rt1, elapsed_time = et1, mut_time = mt1,
+                      mut_elapsed_time = me1,
+                      instrs = is1, mem_reads = mr1, mem_writes = mw1,
+                      cache_misses = cm1,
+                      gc_time = gt1, gc_elapsed_time = ge1, gc_work = gw1,
+                      gc0_time = g0t1, gc0_elapsed_time = g0e1, 
+                      gc1_time = g1t1, gc1_elapsed_time = g1e1, 
+                      balance = b1,
+                      binary_size = bs1, allocs = al1,
+                      run_status = rs1, compile_status = cs1 }
+             Results{ compile_time = ct2, link_time = lt2,
+                      module_size = ms2,
+                      run_time = rt2, elapsed_time = et2, mut_time = mt2,
+                      mut_elapsed_time = me2,
+                      instrs = is2, mem_reads = mr2, mem_writes = mw2,
+                      cache_misses = cm2,
+                      gc_time = gt2, gc_elapsed_time = ge2, gc_work = gw2,
+                      gc0_time = g0t2, gc0_elapsed_time = g0e2, 
+                      gc1_time = g1t2, gc1_elapsed_time = g1e2, 
+                      balance = b2,
+                      binary_size = bs2, allocs = al2,
+                      run_status = rs2, compile_status = cs2 }
+          =  Results{ compile_time   = Map.unionWith (flip const) ct1 ct2,
+                      module_size    = Map.unionWith (flip const) ms1 ms2,
+                      link_time      = lt1 `mplus` lt2,
+                      run_time       = rt1 ++ rt2,
+                      elapsed_time   = et1 ++ et2, 
+                      mut_time       = mt1 ++ mt2,
+                      mut_elapsed_time = me1 ++ me2,
+                      instrs         = is1 `mplus` is2,
+                      mem_reads      = mr1 `mplus` mr2,
+                      mem_writes     = mw1 `mplus` mw2,
+                      cache_misses   = cm1 `mplus` cm2,
+                      gc_time        = gt1 ++ gt2,
+                      gc_elapsed_time= ge1 ++ ge2,
+                      gc0_time        = g0t1 ++ g0t2,
+                      gc0_elapsed_time= g0e1 ++ g0e2,
+                      gc1_time        = g1t1 ++ g1t2,
+                      gc1_elapsed_time= g1e1 ++ g1e2,
+                      balance        = b1 ++ b2,
+                      gc_work        = gw1 `mplus` gw2,
+                      binary_size    = bs1 `mplus` bs2,
+                      allocs         = al1 `mplus` al2,
+                      run_status     = combStatus rs1 rs2,
+                      compile_status = combStatus cs1 cs2 }
+
+combStatus :: Status -> Status -> Status
+combStatus NotDone y       = y
+combStatus x       NotDone = x
+combStatus x       _       = x
+
+chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
+chunk_log header chunk [] = [(header,chunk)]
+chunk_log header chunk (l:ls) =
+        case matchRegex banner_re l of
+                Nothing -> chunk_log header (l:chunk) ls
+                Just stuff -> (header,chunk) : chunk_log stuff [] ls
+
+process_chunk :: ([String],[String]) -> [(String,Results)]
+process_chunk (progName : what : modName : _, chk) =
+ case what of
+        "time to compile" -> parse_compile_time progName modName chk
+        "time to run"     -> parse_run_time progName (reverse chk) emptyResults NotDone
+        "time to compile & run" -> parse_compile_time progName modName chk
+                                ++ parse_run_time progName (reverse chk) emptyResults NotDone
+        "time to link"    -> parse_link_time progName chk
+        "size of"         -> parse_size progName modName chk
+        _                 -> error ("process_chunk: "++what)
+process_chunk _ = error "process_chunk: Can't happen"
+
+parse_compile_time :: String -> String -> [String] -> [(String, Results)]
+parse_compile_time _    _   [] = []
+parse_compile_time progName modName (l:ls) =
+        case time_re l of {
+             Just (_real, user, _system) ->
+                let ct  = Map.singleton modName user
+                in
+                [(progName, emptyResults{compile_time = ct})];
+             Nothing ->
+
+        case time_gnu17_re l of {
+             Just (user, _system, _elapsed) ->
+                let ct  = Map.singleton modName user
+                in
+                [(progName, emptyResults{compile_time = ct})];
+             Nothing ->
+
+        case ghc1_re l of {
+            Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
+              let
+                  time = (initialisation + mut + gc) :: Float
+                  ct  = Map.singleton modName time
+              in
+                [(progName, emptyResults{compile_time = ct})];
+            Nothing ->
+
+        case ghc2_re l of {
+           Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
+              let ct = Map.singleton modName (initialisation + mut + gc)
+              in
+                [(progName, emptyResults{compile_time = ct})];
+            Nothing ->
+
+        case ghc3_re l of {
+           Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
+              let ct = Map.singleton modName (initialisation + mut + gc)
+              in
+                [(progName, emptyResults{compile_time = ct})];
+            Nothing ->
+
+        case ghc4_re l of {
+           Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) ->
+              let ct = Map.singleton modName (initialisation + mut + gc)
+              in
+                [(progName, emptyResults{compile_time = ct})];
+            Nothing ->
+
+                parse_compile_time progName modName ls
+        }}}}}}
+
+parse_link_time :: String -> [String] -> [(String, Results)]
+parse_link_time _ [] = []
+parse_link_time prog (l:ls) =
+          case time_re l of {
+             Just (_real, user, _system) ->
+                [(prog,emptyResults{link_time = Just user})];
+             Nothing ->
+
+          case time_gnu17_re l of {
+             Just (user, _system, _elapsed) ->
+                [(prog,emptyResults{link_time = Just user})];
+             Nothing ->
+
+          parse_link_time prog ls
+          }}
+
+
+-- There might be multiple runs of the program, so we have to collect up
+-- all the results.  Variable results like runtimes are aggregated into
+-- a list, whereas the non-variable aspects are just kept singly.
+parse_run_time :: String -> [String] -> Results -> Status
+               -> [(String, Results)]
+parse_run_time _ [] _ NotDone = []
+parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
+parse_run_time prog (l:ls) res ex =
+        case ghc1_re l of {
+           Just (allocations, _, _, _, _, _, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) ->
+                got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed [] [] [] [] []
+                        Nothing Nothing Nothing Nothing Nothing;
+           Nothing ->
+
+        case ghc2_re l of {
+           Just (allocations, _, _, _, _, _, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) ->
+                got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed [] [] [] [] []
+                        Nothing Nothing Nothing Nothing Nothing;
+
+            Nothing ->
+
+        case ghc3_re l of {
+           Just (allocations, _, _, _, _, gc_work', _, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) ->
+                got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed [] [] [] [] []
+                        (Just gc_work') Nothing Nothing Nothing Nothing;
+
+            Nothing ->
+
+        case ghc4_re l of {
+           Just (allocations, _, _, _, _, gc_work', _, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed, is, mem_rs, mem_ws, cache_misses') ->
+                got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed [] [] [] [] []
+                        (Just gc_work') (Just is) (Just mem_rs)
+                        (Just mem_ws) (Just cache_misses');
+
+            Nothing ->
+
+        case ghc5_re l of {
+           Just (allocations, _, _, _, _, gc_work', _, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed, gc0, gc0_elapsed, gc1, gc1_elapsed, bal) ->
+                got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed
+                        [gc0] [gc0_elapsed] [gc1] [gc1_elapsed] [bal]
+                        (Just gc_work') Nothing Nothing Nothing Nothing;
+
+            Nothing ->
+
+        case matchRegex wrong_output l of {
+            Just ["stdout"] ->
+                parse_run_time prog ls res (combineRunResult WrongStdout ex);
+            Just ["stderr"] ->
+                parse_run_time prog ls res (combineRunResult WrongStderr ex);
+            Just _ -> error "wrong_output: Can't happen";
+            Nothing ->
+
+        case matchRegex wrong_exit_status l of {
+            Just [_wanted, got] ->
+                parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
+            Just _ -> error "wrong_exit_status: Can't happen";
+            Nothing ->
+
+        case matchRegex out_of_heap l of {
+            Just _ ->
+                parse_run_time prog ls res (combineRunResult OutOfHeap ex);
+            Nothing ->
+
+        case matchRegex out_of_stack l of {
+            Just _ ->
+                parse_run_time prog ls res (combineRunResult OutOfStack ex);
+            Nothing ->
+                parse_run_time prog ls res ex;
+
+        }}}}}}}}}
+  where
+  got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed gc0 gc0_elapsed gc1 gc1_elapsed bal gc_work' instrs' mem_rs mem_ws cache_misses'
+      = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
+        let
+          time = initialisation + mut + gc
+          etime = init_elapsed + mut_elapsed + gc_elapsed
+          res' = combine2Results res
+                        emptyResults{   run_time   = [time],
+                                        elapsed_time = [etime],
+                                        mut_time   = [mut],
+                                        mut_elapsed_time   = [mut_elapsed],
+                                        gc_time    = [gc],
+                                        gc_elapsed_time = [gc_elapsed],
+                                        gc0_time    = gc0,
+                                        gc0_elapsed_time = gc0_elapsed,
+                                        gc1_time    = gc1,
+                                        gc1_elapsed_time = gc1_elapsed,
+                                        balance    = bal,
+                                        gc_work    = gc_work',
+                                        allocs     = Just allocations,
+                                        instrs     = instrs',
+                                        mem_reads  = mem_rs,
+                                        mem_writes = mem_ws,
+                                        cache_misses = cache_misses',
+                                        run_status = Success
+                                }
+        in
+        parse_run_time prog ls res' Success
+
+combineRunResult :: Status -> Status -> Status
+combineRunResult OutOfHeap  _           = OutOfHeap
+combineRunResult _          OutOfHeap   = OutOfHeap
+combineRunResult OutOfStack _           = OutOfStack
+combineRunResult _          OutOfStack  = OutOfStack
+combineRunResult (Exit e)   _           = Exit e
+combineRunResult _          (Exit e)    = Exit e
+combineRunResult exit       _            = exit
+
+parse_size :: String -> String -> [String] -> [(String, Results)]
+parse_size _ _ [] = []
+parse_size progName modName (l:ls) =
+        case size_re l of
+            Nothing -> parse_size progName modName ls
+            Just (text, datas, _bss)
+                 | progName == modName ->
+                        [(progName,emptyResults{binary_size = 
+                                             Just (text + datas),
+                                    compile_status = Success})]
+                 | otherwise ->
+                        let ms  = Map.singleton modName (text + datas)
+                        in
+                        [(progName,emptyResults{module_size = ms})]
+