nofib-analyze (empty) → 7.10.1
raw patch · 7 files changed
+1664/−0 lines, 7 filesdep +arraydep +basedep +containerssetup-changed
Dependencies added: array, base, containers, regex-compat
Files
- CmdLine.hs +98/−0
- GenUtils.lhs +226/−0
- LICENSE +30/−0
- Main.hs +786/−0
- Setup.hs +2/−0
- Slurp.hs +486/−0
- nofib-analyze.cabal +36/−0
+ CmdLine.hs view
@@ -0,0 +1,98 @@+-----------------------------------------------------------------------------+-- 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)+ | OptIgnoreSmallTimes Float+ | OptDeviations+ | OptNoDeviations+ | OptTitle String+ | OptColumns String+ | OptRows String+ | OptCSV String+ | OptNormalise String+ | OptStdDev+ | OptShowBaseline+ | 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 ['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 [] ["stddev"] (NoArg OptStdDev)+ "include standard deviations in CSV output"+ , Option ['n'] ["nodeviations"] (NoArg OptNoDeviations)+ "Hide deviations"+ , Option ['t'] ["title"] (ReqArg OptTitle "title")+ "Specify report title"+ , Option ['b'] ["include-baseline"] (NoArg OptShowBaseline)+ "Include the baseline column (LaTeX)"+ ]+
+ GenUtils.lhs view
@@ -0,0 +1,226 @@+-----------------------------------------------------------------------------+-- $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.+-----------------------------------------------------------------------------++> {-# LANGUAGE CPP #-}+> 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+> ) where++> import Data.Ix ( Ix(..) )+> import Data.Array ( listArray, array, (!) )++#define Text Show+#define ASSOC(a,b) (a , b)++%------------------------------------------------------------------------------++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+>++> 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 ]+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 1997-2005, Simon Marlow++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 Simon Marlow 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.
+ Main.hs view
@@ -0,0 +1,786 @@+{-# LANGUAGE RankNTypes, ExistentialQuantification, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- (c) Simon Marlow 1997-2005+-----------------------------------------------------------------------------++module Main where++import GenUtils+import Slurp+import CmdLine++import Text.Printf+import qualified Data.Map as Map+import Data.Map (Map)+import System.Exit ( exitWith, ExitCode(..) )++import Control.Monad+import Data.Maybe ( isNothing )+import System.IO+import Data.List++-----------------------------------------------------------------------------+-- 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 { latex = [ t | OptLaTeXOutput t <- flags ];+ ascii = OptASCIIOutput `elem` flags;+ csv = [ t | OptCSV t <- flags ];+ stddev = OptStdDev `elem` flags;+ inc_baseline = OptShowBaseline `elem` flags+ }++ 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 stddev)+ _ | not (null latex) ->+ putStr (latexOutput results (head latex) column_headings summary_spec summary_rows norm inc_baseline)+ _ | 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 (currently unused)+ (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 (currently unused)+ (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, totmem_spec+ :: PerProgTableSpec+size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok+alloc_spec = SpecP "Allocations" "Allocs" "allocations" (meanInt allocs) run_status always_ok+runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status mean_time_ok+elapsedtime_spec = SpecP "Elapsed Time" "Elapsed" "elapsed-times" (mean elapsed_time) run_status mean_time_ok+muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status mean_time_ok+mutetime_spec = SpecP "Mutator Elapsed Time" "MutETime" "mutator-elapsed-time" (mean mut_elapsed_time) run_status mean_time_ok+gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status mean_time_ok+gcelap_spec = SpecP "GC Elapsed Time" "GCETime" "gc-elapsed-time" (mean gc_elapsed_time) run_status mean_time_ok+gc0count_spec = SpecP "GC(0) Count" "GC0Count" "gc0-count" (meanInt gc0_count) run_status always_ok+gc0time_spec = SpecP "GC(0) Time" "GC0Time" "gc0-time" (mean gc0_time) run_status mean_time_ok+gc0elap_spec = SpecP "GC(0) Elapsed Time" "GC0ETime" "gc0-elapsed-time" (mean gc0_elapsed_time) run_status mean_time_ok+gc1count_spec = SpecP "GC(1) Count" "GC1Count" "gc1-count" (meanInt gc1_count) run_status always_ok+gc1time_spec = SpecP "GC(1) Time" "GC1Time" "gc1-time" (mean gc1_time) run_status mean_time_ok+gc1elap_spec = SpecP "GC(1) Elapsed Time" "GC1ETime" "gc1-elapsed-time" (mean gc1_elapsed_time) run_status mean_time_ok+balance_spec = SpecP "GC work balance" "Balance" "balance" (mean balance) run_status mean_time_ok+gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" (meanInt 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+totmem_spec = SpecP "Total Memory in use" "TotalMem" "total-mem" (meanInt total_memory) 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,+ gc0count_spec,+ gc0time_spec,+ gc0elap_spec,+ gc1count_spec,+ gc1time_spec,+ gc1elap_spec,+ balance_spec,+ gcwork_spec,+ instrs_spec,+ mreads_spec,+ mwrite_spec,+ cmiss_spec,+ totmem_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 (MeanStdDev Float)+mean f results = go (f results)+ where go [] = Nothing+ go fs = Just (MeanStdDev mn stddev)+ where mn = sn / n+ stddev = (sqrt (n * sum (map (^2) fs) - sn^2)) / n+ sn = foldl' (+) 0 fs+ n = fromIntegral (length fs)++meanInt :: Integral a => (Results -> [a]) -> Results -> Maybe (MeanStdDev a)+meanInt f results = go (f results)+ where go [] = Nothing+ go fs = Just (MeanStdDev mn 0)+ where mn = foldl' (+) 0 fs `quot` 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, gc0count_spec, gc0time_spec, gc0elap_spec, gc1count_spec, gc1time_spec, gc1elap_spec,+ gcwork_spec, balance_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec, totmem_spec]++-- A single summary table, giving comparison figures for a number of+-- aspects, each in its own column. Only works when comparing at least two runs.+normal_summary_specs :: [PerProgTableSpec]+normal_summary_specs =+ [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec, totmem_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+ , SpecM "Compile Allocations" "compile-allocations" compile_allocs always_ok+ ]++always_ok :: a -> Bool+always_ok = const True++mean_time_ok :: (MeanStdDev Float) -> Bool+mean_time_ok = time_ok . float++time_ok :: Float -> Bool+time_ok t = t > tooquick_threshold++-----------------------------------------------------------------------------+-- LaTeX table generation (just the summary for now)++latexOutput :: [ResultTable] -> Maybe String -> [String] -> [PerProgTableSpec]+ -> Maybe [String] -> Normalise -> Bool -> String++latexOutput results (Just table_name) _ _ _ norm inc_baseline+ = 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 inc_baseline "\n"++latexOutput results Nothing column_headings summary_spec summary_rows _ _ =+ (if (length results >= 2)+ then ascii_summary_table True results column_headings summary_spec summary_rows+ . str "\n\n"+ else id) ""+++latexProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> Bool -> ShowS+latexProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm inc_baseline+ = latex_show_results results get_result get_status result_ok norm inc_baseline++latex_show_results+ :: Result a+ => [ResultTable]+ -> (Results -> Maybe a)+ -> (Results -> Status)+ -> (a -> Bool)+ -> Normalise+ -> Bool+ -> ShowS++latex_show_results [] _ _ _ _ _+ = error "latex_show_results: Can't happen?"+latex_show_results (r:rs) f stat _result_ok norm inc_baseline+ = 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, if inc_baseline then xs else 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 at least two runs+ . (if (length results >= 2)+ then ascii_summary_table False results args 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 (intersperse (str (space 1)) (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]+ -> [String]+ -> [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 (rbase:rs) (_:names) specs mb_restrict+ | latex = makeLatexTable (rows ++ TableLine : av_rows)+ | otherwise =+ makeTable (table_layout (length specs * length rs) w) $+ [ TableLine+ , TableRow header_row ] +++ [ TableRow header_row2 | length rs > 1] +++ [ TableLine ] +++ rows +++ [ TableLine ] +++ av_rows+ where+ header_row = BoxString "Program" : map BoxString headings+ header_row2 = BoxString "" : map BoxString headings2++ (headings, headings2, columns, av_cols) = unzip4 (concatMap calc_col_group specs)+ av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]+ baseline = Map.toList rbase+ progs = map BoxString (Map.keys rbase)+ rows0 = map TableRow (zipWith (:) progs (transpose columns))++ rows = restrictRows mb_restrict rows0++ av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))+ w = sUMMARY_FIELD_WIDTH++ calc_col_group :: PerProgTableSpec -> [(String, String, [BoxValue], [BoxValue])]+ calc_col_group spec = [calc_col spec r n | (r,n) <- zip rs names]++ calc_col :: PerProgTableSpec -> ResultTable -> String -> (String, String, [BoxValue], [BoxValue])+ calc_col (SpecP _ heading _ getr gets ok) r n+ -- throw away the baseline result+ = (heading, n, column, [column_min, column_max, column_mean])+ where (_, boxes) = unzip (map calc_one_result baseline)+ calc_one_result = calc_result [r] 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++table_layout :: Int -> Int -> Layout+table_layout n w boxes = foldr (.) id $ intersperse (str (space 1)) $ 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 (intersperse (str (space 1)) (map (str . rjustify w . showBox) results))++-- -----------------------------------------------------------------------------+-- CSV output++csvTable :: [ResultTable] -> String -> Normalise -> Bool -> String+csvTable results table_name norm stddev+ = 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 stddev "\n"++csvProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> Bool -> ShowS+csvProgTable results (SpecP _long_name _ _ get_result get_status result_ok)+ norm stddev+ = csv_show_results results get_result get_status result_ok norm stddev++csv_show_results+ :: Result a+ => [ResultTable]+ -> (Results -> Maybe a)+ -> (Results -> Status)+ -> (a -> Bool)+ -> Normalise+ -> Bool+ -> ShowS++csv_show_results [] _ _ _ _ _+ = error "csv_show_results: Can't happen?"+csv_show_results (r:rs) f stat _result_ok norm stddev+ = 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)+ | stddev = interleave "," (str prog : concat (map stddevbox boxes))+ | otherwise = interleave "," (str prog : map (str.showBox) boxes)++ stddevbox (BoxStdDev b s) = [str (showBox b), str (printf "%.3f" s)]+ stddevbox b = [str (showBox b), str "0"]++-- ---------------------------------------------------------------------------+-- 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 n _val | float n < 0.0001 = Percentage 100+convert_to_percentage baseline val = Percentage ((float val / float baseline) * 100)++normalise_to_base :: Result a => a -> a -> BoxValue+normalise_to_base n _val | float n < 0.0001 = BoxFloat 1+normalise_to_base baseline val =+ BoxStdDev (BoxFloat point)+ (point - (float baseline / (float val + variance val)))+ where+ point = (float baseline / float val)++class Result a where+ toBox :: a -> BoxValue+ float :: a -> Float+ variance :: a -> Float++-- We assume an Int is a size, and print it in kilobytes.++instance Result Int where+ toBox = BoxInt+ float a = fromIntegral a+ variance a = 0++data MeanStdDev a = MeanStdDev a Float++instance Result a => Result (MeanStdDev a) where+ toBox (MeanStdDev a b) = BoxStdDev (toBox a) b+ float (MeanStdDev a _) = float a+ variance (MeanStdDev _ b) = b++instance Result Integer where+ toBox = BoxInteger+ float a = fromIntegral a+ variance a = 0++instance Result Float where+ toBox = BoxFloat+ float a = realToFrac a+ variance a = 0++-- -----------------------------------------------------------------------------+-- BoxValues++-- The contents of a box in a table+data BoxValue+ = RunFailed Status+ | Percentage Float+ | BoxFloat Float+ | BoxInt Int+ | BoxInteger Integer+ | BoxString String+ | BoxStdDev BoxValue Float++showBox :: BoxValue -> String+showBox (RunFailed stat) = show_stat stat+showBox (Percentage 100) = " 0.0%" -- pattern matching on Float is bad style, but this is not crucial+showBox (Percentage f) = case printf "%.1f%%" (f-100) of+ xs@('-':_) -> xs+ xs -> '+':xs+showBox (BoxFloat f) = printf "%.3f" f+showBox (BoxInt n) = show n+showBox (BoxInteger n) = show n+--showBox (BoxInt n) = show (n `div` (1024*1024))+--showBox (BoxInteger n) = show (n `div` (1024*1024))+--showBox (BoxInt n) = show (n `div` 1024) ++ "k"+--showBox (BoxInteger n) = show (n `div` 1024) ++ "k"+showBox (BoxString s) = s+showBox (BoxStdDev b f) = showBox b++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 (mungeForLaTeX (show s))++mungeForLaTeX :: String -> String+mungeForLaTeX = foldr transchar ""+ where+ transchar '_' s = '\\':'_':s+ transchar '%' s = '\\':'%':s+ 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++sUMMARY_FIELD_WIDTH :: Int+sUMMARY_FIELD_WIDTH = 9++-----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Slurp.hs view
@@ -0,0 +1,486 @@+-----------------------------------------------------------------------------+--+-- (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 Data.List (isPrefixOf)+import Text.Regex+-- 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,+ compile_allocs :: Map String Integer,+ 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 :: [Integer],+ gc_time :: [Float],+ gc_elapsed_time :: [Float],+ gc0_count :: [Int],+ gc0_time :: [Float],+ gc0_elapsed_time :: [Float],+ gc1_count :: [Int],+ gc1_time :: [Float],+ gc1_elapsed_time :: [Float],+ balance :: [Float],+ allocs :: [Integer],+ run_status :: Status,+ compile_status :: Status,+ total_memory :: [Integer]+ }++emptyResults :: Results+emptyResults = Results {+ compile_time = Map.empty,+ compile_allocs = 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_count = [],+ gc0_time = [],+ gc0_elapsed_time = [],+ gc1_count = [],+ gc1_time = [],+ gc1_elapsed_time = [],+ balance = [],+ gc_work = [],+ allocs = [],+ compile_status = NotDone,+ run_status = NotDone,+ total_memory = []+ }++-----------------------------------------------------------------------------+-- 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)+ghc6_re = GHC 7.2 (includes GC counts)+-}++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, 1048576 * 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', 1048576 * 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', 1048576 * 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', 1048576 * 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>>"++ghc6_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float,Int,Float,Float,Int,Float,Float,Float)+ghc6_re s = case matchRegex re s of+ Just [allocations, gcs, gc0_count, gc1_count, 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', 1048576 * read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed, read gc0_count, read gc0, read gc0_elapsed, read gc1_count, 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]+)[ \t]*\\+[ \t]*([0-9]+)\\),[ \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,+ compile_allocs = ca1,+ 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_count = g0c1, gc0_time = g0t1, gc0_elapsed_time = g0e1,+ gc1_count = g1c1, gc1_time = g1t1, gc1_elapsed_time = g1e1,+ balance = b1,+ binary_size = bs1, allocs = al1,+ run_status = rs1, compile_status = cs1,+ total_memory = tm1 }+ Results{ compile_time = ct2, link_time = lt2,+ compile_allocs = ca2,+ 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_count = g0c2, gc0_time = g0t2, gc0_elapsed_time = g0e2,+ gc1_count = g1c2, gc1_time = g1t2, gc1_elapsed_time = g1e2,+ balance = b2,+ binary_size = bs2, allocs = al2,+ run_status = rs2, compile_status = cs2,+ total_memory = tm2 }+ = Results{ compile_time = Map.unionWith (flip const) ct1 ct2,+ compile_allocs = Map.unionWith (flip const) ca1 ca2,+ 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_count = g0c1 ++ g0c2,+ gc0_time = g0t1 ++ g0t2,+ gc0_elapsed_time= g0e1 ++ g0e2,+ gc1_count = g1c1 ++ g1c2,+ gc1_time = g1t1 ++ g1t2,+ gc1_elapsed_time= g1e1 ++ g1e2,+ balance = b1 ++ b2,+ gc_work = gw1 ++ gw2,+ binary_size = bs1 `mplus` bs2,+ allocs = al1 ++ al2,+ run_status = combStatus rs1 rs2,+ compile_status = combStatus cs1 cs2,+ total_memory = tm1 ++ tm2 }++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 ghc1_re l of {+ Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->+ got_compile_result allocations initialisation mut gc;+ Nothing ->++ case ghc2_re l of {+ Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->+ got_compile_result allocations initialisation mut gc;+ Nothing ->++ case ghc3_re l of {+ Just (allocations, _, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->+ got_compile_result allocations initialisation mut gc;+ Nothing ->++ case ghc4_re l of {+ Just (allocations, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) ->+ got_compile_result allocations initialisation mut gc;+ Nothing ->++ parse_compile_time progName modName ls+ }}}}+ where got_compile_result allocations initialisation mut gc =+ let ct = Map.singleton modName (initialisation + mut + gc)+ ca = Map.singleton modName allocations+ res = emptyResults {compile_time = ct, compile_allocs = ca}+ in+ [(progName, res)]++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 ->++ case ghc2_re l of {+ Just (allocations, _, _, _, _, in_use, 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 [in_use];++ Nothing ->++ case ghc3_re l of {+ Just (allocations, _, _, _, _, gc_work', in_use, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) ->+ got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed [] [] [] [] [] [] []+ [gc_work'] Nothing Nothing Nothing Nothing [in_use];++ Nothing ->++ case ghc4_re l of {+ Just (allocations, _, _, _, _, gc_work', in_use, 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 [] [] [] [] [] [] []+ [gc_work'] (Just is) (Just mem_rs)+ (Just mem_ws) (Just cache_misses') [in_use];++ Nothing ->++ case ghc5_re l of {+ Just (allocations, _, _, _, _, gc_work', in_use, 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]+ [gc_work'] Nothing Nothing Nothing Nothing [in_use];++ Nothing ->++ case ghc6_re l of {+ Just (allocations, _, _, _, _, gc_work', in_use, initialisation, init_elapsed, mut, mut_elapsed, gc, gc_elapsed, gc0_count, gc0, gc0_elapsed, gc1_count, gc1, gc1_elapsed, bal) ->+ got_run_result allocations initialisation init_elapsed mut mut_elapsed gc gc_elapsed+ [gc0_count] [gc0] [gc0_elapsed] [gc1_count] [gc1] [gc1_elapsed] [bal]+ [gc_work'] Nothing Nothing Nothing Nothing [in_use];++ Nothing | "<<ghc" `isPrefixOf` l -> error $ "Failed to parse GHC output " ++ show l+ | otherwise ->++ 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_count gc0 gc0_elapsed gc1_count gc1 gc1_elapsed bal gc_work' instrs' mem_rs mem_ws cache_misses' in_use+ = -- 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_count = gc0_count,+ gc0_time = gc0,+ gc0_elapsed_time = gc0_elapsed,+ gc1_count = gc1_count,+ gc1_time = gc1,+ gc1_elapsed_time = gc1_elapsed,+ balance = bal,+ gc_work = gc_work',+ allocs = [allocations],+ instrs = instrs',+ mem_reads = mem_rs,+ mem_writes = mem_ws,+ cache_misses = cache_misses',+ run_status = Success,+ total_memory = in_use+ }+ 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})]+
+ nofib-analyze.cabal view
@@ -0,0 +1,36 @@+name: nofib-analyze+version: 7.10.1+synopsis: Parse and compare nofib runs+description:+ The nofib benchmark suite is the standard benchmark suite+ to measure Haskell compilers. The nofib-analyze program can parse+ the logs of nofib runs, and compare their output, producing tables in text,+ LaTeX or HTML format.+ .+ nofib-analyze is readily available in your GHC source tree in+ @nofib/nofib-analyse@, so usually, you will not need this packages. It might+ however be handy when you need to analyze log files without having a checked-out+ copy of GHC around.+homepage: https://ghc.haskell.org/trac/ghc/wiki/Building/RunningNoFib+license: BSD3+license-file: LICENSE+author: Simon Marlow+maintainer: Joachim Breitner <mail@joachim-breitner.de>+copyright: 1997 - 2005 Simon Marlow +category: Development+build-type: Simple+cabal-version: >=1.10++executable nofib-analyze+ main-is: Main.hs+ other-modules: CmdLine, GenUtils, Slurp+ build-depends:+ base >=4.3 && <4.9,+ regex-compat == 0.95.*,+ array >= 0.3 && < 0.6,+ containers >= 0.4 && < 0.6+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/nomeata/nofib-analyze