{-# 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
-----------------------------------------------------------------------------