import System.IO
import Data.List
+(<!) :: Text.Html.ADDATTRS a => a -> [HtmlAttr] -> a
(<!) = (Html.!)
-----------------------------------------------------------------------------
let { html = OptHTMLOutput `elem` flags;
latex = OptLaTeXOutput `elem` flags;
- ascii = OptASCIIOutput `elem` flags
+ ascii = OptASCIIOutput `elem` flags;
+ csv = [ table | OptCSV table <- flags ];
+ no_norm = OptNoNormalise `elem` flags;
}
when (ascii && html) $ die "Can't produce both ASCII and HTML"
(prog,res) <- Map.toList result_table ]
case () of
+ _ | not (null csv) ->
+ putStr (csvTable results (head csv) (not no_norm))
_ | html ->
putStr (renderHtml (htmlPage results column_headings))
_ | latex ->
(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, muttime_spec, gctime_spec,
- gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec
+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
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,
-- 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, muttime_spec, gctime_spec,
- gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ]
+ [ 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 ]
+ [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec ]
cachegrind_summary_specs :: [PerProgTableSpec]
cachegrind_summary_specs =
+++ 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)
+ ++ map (module_menu_item) per_module_result_tab)
-prog_menu_item (SpecP name _ anc _ _ _) = anchor <! [href ('#':anc)] << name
-module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
+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)
+ foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
+ +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
-htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
- = sectHeading title anc
+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 results args (SpecM title anc get_result result_ok)
- = sectHeading title anc
+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
-> (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)
++ [tableRow (-1) ("Average", gms)])
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
- results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
+ 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)
-> (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)
<-> tableRow (-1) ("", highs)])
++ [td << bold << "Average"
<-> tableRow (-1) ("", gms)])
-
where
base_results = Map.toList r :: [(String,Results)]
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,r) = (prog, map get_results_for_mod (Map.toList (f r)))
+ get_results_for_prog (prog, results)
+ = (prog, map get_results_for_mod (Map.toList (f results)))
where fms = map get_run_results rs
Nothing -> Map.empty
Just res -> f res
- get_results_for_mod (id,attr) = calc_result fms Just (const Success)
- result_ok (id,attr)
+ 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
| 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
<-> logHeaders ss
-- Calculate a color ranging from bright blue for -100% to bright red for +100%.
-
calcColor :: Int -> String
-calcColor p | p >= 0 = "#" ++ (showHex red 2 "0000")
- | otherwise = "#0000" ++ (showHex blue 2 "")
- where red = p * 255 `div` 100
- blue = (-p) * 255 `div` 100
-
-showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s
-showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s)
-
-hexDig i | i > 10 = chr (i-10 + ord 'a')
- | otherwise = chr (i + ord '0')
+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 results args summary_spec summary_rows =
+latexOutput :: [ResultTable] -> [String] -> [PerProgTableSpec]
+ -> Maybe [String] -> String
+latexOutput results _ summary_spec summary_rows =
(if (length results == 2)
then ascii_summary_table True results summary_spec summary_rows
. str "\n\n"
-----------------------------------------------------------------------------
-- ASCII page generation
+asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String]
+ -> String
asciiPage results args summary_spec summary_rows =
( str reportTitle
. str "\n\n"
. interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab)
) "\n"
-asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
- = str title
+asciiGenProgTable :: [ResultTable] -> [String] -> PerProgTableSpec -> ShowS
+asciiGenProgTable results args (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
-asciiGenModTable results args (SpecM title anc get_result result_ok)
- = str title
+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 width ss
+ascii_header :: Int -> [String] -> ShowS
+ascii_header w ss
= str "\n-------------------------------------------------------------------------------\n"
. str (rjustify 15 "Program")
. str (space 5)
- . foldr (.) id (map (str . rjustify width) ss)
+ . foldr (.) id (map (str . rjustify w) ss)
. str "\n-------------------------------------------------------------------------------\n"
ascii_show_results
-> (a -> Bool)
-> ShowS
+ascii_show_results [] _ _ _ _
+ = error "ascii_show_results: Can't happen?"
ascii_show_results (r:rs) ss f stat result_ok
= ascii_header fIELD_WIDTH ss
. interleave "\n" (map show_per_prog_results results_per_prog)
. show_per_prog_results ("Average",gms)
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
- results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
+ 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)
-> [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) width)
- (TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows)
+ makeTable (table_layout (length specs) w)
+ (TableLine : TableRow header_row :
+ TableLine : rows ++
+ TableLine : av_rows)
where
- header = BoxString "Program" : map BoxString headings
+ 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"]
| otherwise = rows1
av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
- width = 10
+ w = 10
calc_col (SpecP _ heading _ getr gets ok)
- = (heading, column, [min,max,mean]) -- throw away the baseline result
+ -- 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
+ calc_one_result = calc_result [r2] getr gets ok convert_to_percentage
column = map (\(_:b:_) -> b) boxes
- (_,mean,_) = calc_gmsd column
- (min,max) = calc_minmax column
+ (_, column_mean, _) = calc_gmsd column
+ (column_min, column_max) = calc_minmax column
restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
restrictRows Nothing rows = rows
transchar '_' s = '\\':'_':s
transchar c s = c:s
-table_layout n width =
+table_layout :: Int -> Int -> Layout
+table_layout n w =
(str . rjustify 15) :
- (\s -> str (space 5) . str (rjustify width s)) :
- replicate (n-1) (str . rjustify width)
+ (\s -> str (space 5) . str (rjustify w s)) :
+ replicate (n-1) (str . rjustify w)
ascii_show_multi_results
:: Result 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)
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,r) = (prog, map get_results_for_mod (Map.toList (f r)))
+ get_results_for_prog (prog, results)
+ = (prog, map get_results_for_mod (Map.toList (f results)))
where fms = map get_run_results rs
Nothing -> Map.empty
Just res -> f res
- get_results_for_mod (id,attr) = calc_result fms Just (const Success)
- result_ok (id,attr)
+ 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")
show_per_prog_results :: (String, [BoxValue]) -> ShowS
show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
-show_per_prog_results_width width (prog,results)
+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 width . showBox) results)
+ . foldr (.) id (map (str . rjustify w . showBox) results)
+
+-- -----------------------------------------------------------------------------
+-- CSV output
+
+csvTable :: [ResultTable] -> String -> Bool -> 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 -> Bool -> 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)
+ -> Bool
+ -> 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) do_norm
+
+ do_norm | norm = normalise_to_base
+ | otherwise = \base res -> toBox res
+
+ result_line (prog,boxes) = interleave "," (str prog : map (str.showBox) boxes)
-- ---------------------------------------------------------------------------
-- Generic stuff for results generation
=> [Map String b] -- accumulated results
-> (b -> Maybe a) -- get a result from the b
-> (b -> Status) -- get a status from the b
- -> (a -> Bool) -- is this result ok?
+ -> (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 result_ok (prog,base_r) =
- (prog, (just_result baseline base_stat :
+calc_result rts get_maybe_a get_stat base_ok normalise (prog,base_r) =
+ (prog, (just_result m_baseline base_stat :
let
rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
get_stuff (Just r) = (get_maybe_a r, get_stat r)
in
(
- case baseline of
- Just base | result_ok base
- -> map (\(r,s) -> percentage r s base) rts'
- _other
- -> map (\(r,s) -> just_result r s) rts'
+ 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
- baseline = get_maybe_a base_r
+ 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
- percentage Nothing s _ = RunFailed s
- percentage (Just a) _ base = Percentage
- (convert_to_percentage base a)
+ do_norm Nothing s _ = RunFailed s
+ do_norm (Just a) _ baseline = normalise baseline a
+
-----------------------------------------------------------------------------
-- Calculating geometric means and standard deviations
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
- devs = map (sqr . (lbar-)) logs
- dbar = sum devs / len
- gm = exp lbar
- sdf = exp (sqrt dbar)
+ | 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,
-----------------------------------------------------------------------------
-- Show the Results
-class Num a => Result a where
+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
- convert_to_percentage :: a -> a -> Float
-- We assume an Int is a size, and print it in kilobytes.
instance Result Int where
- convert_to_percentage 0 _ = 100
- convert_to_percentage base size
- = (fromIntegral size / fromIntegral base) * 100
-
toBox = BoxInt
instance Result Integer where
- convert_to_percentage 0 _ = 100
- convert_to_percentage base size
- = (fromInteger size / fromInteger base) * 100
toBox = BoxInteger
instance Result Float where
- convert_to_percentage 0.0 _ = 100.0
- convert_to_percentage base size = size / base * 100
-
toBox = BoxFloat
-- -----------------------------------------------------------------------------
showBox :: BoxValue -> String
showBox (RunFailed stat) = show_stat stat
-showBox (Percentage f) = printf "%+.1f%%" (f-100)
+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"
type Layout = [String -> ShowS]
makeTable :: Layout -> [TableRow] -> ShowS
-makeTable p = interleave "\n" . map do_row
- where do_row (TableRow boxes) = applyLayout p boxes
+makeTable layout = interleave "\n" . map do_row
+ where do_row (TableRow boxes) = applyLayout layout boxes
do_row TableLine = str (take 80 (repeat '-'))
makeLatexTable :: [TableRow] -> ShowS
-- General Utils
split :: Char -> String -> [String]
-split c s = case rest of
- [] -> [chunk]
- _:rest -> chunk : split c rest
- where (chunk, rest) = break (==c) s
+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 = 16 :: Int
+fIELD_WIDTH :: Int
+fIELD_WIDTH = 16
-----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff