1 -----------------------------------------------------------------------------
2 -- $Id: Main.hs,v 1.10 2005/06/07 10:58:31 simonmar Exp $
4 -- (c) Simon Marlow 1997-2005
5 -----------------------------------------------------------------------------
14 import Text.Html hiding (cols, rows, (!))
15 import qualified Text.Html as Html ((!))
16 import qualified Data.Map as Map
18 import System.Exit ( exitWith, ExitCode(..) )
21 import Data.Maybe ( isNothing )
26 (<!) :: Text.Html.ADDATTRS a => a -> [HtmlAttr] -> a
29 -----------------------------------------------------------------------------
33 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
35 data Normalise = NormalisePercent | NormaliseRatio | NormaliseNone
40 when (not (null cmdline_errors) || OptHelp `elem` flags) $
41 die (concat cmdline_errors ++ usage)
43 norm <- case [ n | OptNormalise n <- flags ] of
44 [] -> return NormalisePercent
45 ["percent"] -> return NormalisePercent
46 ["ratio"] -> return NormaliseRatio
47 ["none"] -> return NormaliseNone
48 _ -> die ("unrecognised value for --normalise\n" ++ usage)
50 let { html = OptHTMLOutput `elem` flags;
51 latex = [ t | OptLaTeXOutput t <- flags ];
52 ascii = OptASCIIOutput `elem` flags;
53 csv = [ t | OptCSV t <- flags ];
56 when (ascii && html) $ die "Can't produce both ASCII and HTML"
57 when (devs && nodevs) $ die "Can't both display and hide deviations"
59 results <- parse_logs other_args
61 summary_spec <- case [ cols | OptColumns cols <- flags ] of
62 [] -> return (pickSummary results)
63 (cols:_) -> namedColumns (split ',' cols)
65 let summary_rows = case [ rows | OptRows rows <- flags ] of
67 rows -> Just (split ',' (last rows))
69 let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
72 sequence_ [ checkTimes prog res | result_table <- results,
73 (prog,res) <- Map.toList result_table ]
77 putStr (csvTable results (head csv) norm)
79 putStr (renderHtml (htmlPage results column_headings))
80 _ | not (null latex) ->
81 putStr (latexOutput results (head latex) column_headings summary_spec summary_rows norm)
83 putStr (asciiPage results column_headings summary_spec summary_rows norm)
86 parse_logs :: [String] -> IO [ResultTable]
88 f <- hGetContents stdin
90 parse_logs log_files =
91 mapM (\f -> do h <- openFile f ReadMode
93 return (parse_log c)) log_files
95 -----------------------------------------------------------------------------
96 -- List of tables we're going to generate
98 data PerProgTableSpec =
99 forall a . Result a =>
101 String -- Name of the table
102 String -- Short name (for column heading)
103 String -- HTML tag for the table
104 (Results -> Maybe a) -- How to get the result
105 (Results -> Status) -- How to get the status of this result
106 (a -> Bool) -- Result within reasonable limits?
108 data PerModuleTableSpec =
109 forall a . Result a =>
111 String -- Name of the table
112 String -- HTML tag for the table
113 (Results -> Map String a) -- get the module map
114 (a -> Bool) -- Result within reasonable limits?
116 -- The various per-program aspects of execution that we can generate results for.
117 size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec,
118 gctime_spec, gcelap_spec,
119 gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec,
120 gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec, balance_spec
122 size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
123 alloc_spec = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok
124 runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok
125 elapsedtime_spec = SpecP "Elapsed Time" "Elapsed" "elapsed-times" (mean elapsed_time) run_status time_ok
126 muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok
127 mutetime_spec = SpecP "Mutator Elapsed Time" "MutETime" "mutator-elapsed-time" (mean mut_elapsed_time) run_status time_ok
128 gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok
129 gcelap_spec = SpecP "GC Elapsed Time" "GCETime" "gc-elapsed-time" (mean gc_elapsed_time) run_status time_ok
130 gc0time_spec = SpecP "GC(0) Time" "GC0Time" "gc0-time" (mean gc0_time) run_status time_ok
131 gc0elap_spec = SpecP "GC(0) Elapsed Time" "GC0ETime" "gc0-elapsed-time" (mean gc0_elapsed_time) run_status time_ok
132 gc1time_spec = SpecP "GC(1) Time" "GC1Time" "gc1-time" (mean gc1_time) run_status time_ok
133 gc1elap_spec = SpecP "GC(1) Elapsed Time" "GC1ETime" "gc1-elapsed-time" (mean gc1_elapsed_time) run_status time_ok
134 balance_spec = SpecP "GC work balance" "Balance" "balance" (mean balance) run_status time_ok
135 gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok
136 instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
137 mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
138 mwrite_spec = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok
139 cmiss_spec = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok
141 all_specs :: [PerProgTableSpec]
163 namedColumns :: [String] -> IO [PerProgTableSpec]
164 namedColumns ss = mapM findSpec ss
166 case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
168 [] -> die ("unknown column: " ++ s)
169 (spec:_) -> return spec
171 mean :: (Results -> [Float]) -> Results -> Maybe Float
172 mean f results = go (f results)
173 where go [] = Nothing
174 go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs))
176 -- Look for bogus-looking times: On Linux we occasionally get timing results
177 -- that are bizarrely low, and skew the average.
178 checkTimes :: String -> Results -> IO ()
179 checkTimes prog results = do
180 check "run time" (run_time results)
181 check "mut time" (mut_time results)
182 check "GC time" (gc_time results)
186 hPutStrLn stderr ("warning: dubious " ++ kind
187 ++ " results for " ++ prog
189 | otherwise = return ()
190 where strange t = any (\r -> time_ok r && r / t > 1.4) ts
191 -- looks for times that are >40% smaller than
195 -- These are the per-prog tables we want to generate
196 per_prog_result_tab :: [PerProgTableSpec]
197 per_prog_result_tab =
198 [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec, gctime_spec,
199 gcelap_spec, gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec,
200 gcwork_spec, balance_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec]
202 -- A single summary table, giving comparison figures for a number of
203 -- aspects, each in its own column. Only works when comparing two runs.
204 normal_summary_specs :: [PerProgTableSpec]
205 normal_summary_specs =
206 [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec ]
208 cachegrind_summary_specs :: [PerProgTableSpec]
209 cachegrind_summary_specs =
210 [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
212 -- Pick an appropriate summary table: if we're cachegrinding, then
213 -- we're probably not interested in the runtime, but we are interested
214 -- in instructions, mem reads and mem writes (and vice-versa).
215 pickSummary :: [ResultTable] -> [PerProgTableSpec]
217 | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
218 | otherwise = cachegrind_summary_specs
220 per_module_result_tab :: [PerModuleTableSpec]
221 per_module_result_tab =
222 [ SpecM "Module Sizes" "mod-sizes" module_size always_ok
223 , SpecM "Compile Times" "compile-time" compile_time time_ok
226 always_ok :: a -> Bool
227 always_ok = const True
229 time_ok :: Float -> Bool
230 time_ok t = t > tooquick_threshold
232 -----------------------------------------------------------------------------
233 -- HTML page generation
235 htmlPage :: [ResultTable] -> [String] -> Html
236 htmlPage results args
237 = header << thetitle << reportTitle
239 +++ h1 << reportTitle
242 +++ body (gen_tables results args)
245 gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
246 ++ map (module_menu_item) per_module_result_tab)
248 prog_menu_item :: PerProgTableSpec -> Html
249 prog_menu_item (SpecP long_name _ anc _ _ _)
250 = anchor <! [href ('#':anc)] << long_name
251 module_menu_item :: PerModuleTableSpec -> Html
252 module_menu_item (SpecM long_name anc _ _)
253 = anchor <! [href ('#':anc)] << long_name
255 gen_tables :: [ResultTable] -> [String] -> Html
256 gen_tables results args =
257 foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
258 +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
260 htmlGenProgTable :: [ResultTable] -> [String] -> PerProgTableSpec -> Html
261 htmlGenProgTable results args (SpecP long_name _ anc get_result get_status result_ok)
262 = sectHeading long_name anc
263 +++ font <! [size "1"]
264 << mkTable (htmlShowResults results args get_result get_status result_ok)
267 htmlGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> Html
268 htmlGenModTable results args (SpecM long_name anc get_result result_ok)
269 = sectHeading long_name anc
270 +++ font <![size "1"]
271 << mkTable (htmlShowMultiResults results args get_result result_ok)
274 sectHeading :: String -> String -> Html
275 sectHeading s nm = h2 << anchor <! [name nm] << s
281 -> (Results -> Maybe a)
282 -> (Results -> Status)
286 htmlShowResults [] _ _ _ _
287 = error "htmlShowResults: Can't happen?"
288 htmlShowResults (r:rs) ss f stat result_ok
290 </> aboves (zipWith tableRow [1..] results_per_prog)
291 </> aboves ((if nodevs then []
292 else [tableRow (-1) ("-1 s.d.", lows),
293 tableRow (-1) ("+1 s.d.", highs)])
294 ++ [tableRow (-1) ("Average", gms)])
296 -- results_per_prog :: [ (String,[BoxValue a]) ]
297 results_per_prog = map (calc_result rs f stat result_ok convert_to_percentage) (Map.toList r)
299 results_per_run = transpose (map snd results_per_prog)
300 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
306 -> (Results -> Map String a)
310 htmlShowMultiResults [] _ _ _
311 = error "htmlShowMultiResults: Can't happen?"
312 htmlShowMultiResults (r:rs) ss f result_ok =
314 </> aboves (map show_results_for_prog results_per_prog_mod_run)
315 </> aboves ((if nodevs then []
316 else [td << bold << "-1 s.d."
317 <-> tableRow (-1) ("", lows),
318 td << bold << "+1 s.d."
319 <-> tableRow (-1) ("", highs)])
320 ++ [td << bold << "Average"
321 <-> tableRow (-1) ("", gms)])
323 base_results = Map.toList r :: [(String,Results)]
325 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
326 results_per_prog_mod_run = map get_results_for_prog base_results
328 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
329 get_results_for_prog (prog, results)
330 = (prog, map get_results_for_mod (Map.toList (f results)))
332 where fms = map get_run_results rs
334 get_run_results fm = case Map.lookup prog fm of
338 get_results_for_mod id_attr
339 = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
341 show_results_for_prog (prog,mrs) =
342 td <! [valign "top"] << bold << prog
343 <-> (if null mrs then
344 td << "(no modules compiled)"
346 toHtml (aboves (map (tableRow 0) mrs)))
348 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
350 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
352 tableRow :: Int -> (String, [BoxValue]) -> HtmlTable
353 tableRow row_no (prog, results)
354 = td <! [bgcolor left_column_color] << prog
355 <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
357 where clr | row_no < 0 = bgcolor average_row_color
358 | even row_no = bgcolor even_row_color
359 | otherwise = bgcolor odd_row_color
361 left_column_color, odd_row_color, even_row_color, average_row_color :: String
362 left_column_color = "#d0d0ff" -- light blue
363 odd_row_color = "#d0d0ff" -- light blue
364 even_row_color = "#f0f0ff" -- v. light blue
365 average_row_color = "#ffd0d0" -- light red
368 findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
369 findBest stuff@(Result base : rest)
370 = map (\a -> (a==base, a))
372 best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
374 no_pcnt_stuff = map unPcnt stuff
376 unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
377 unPcnt (r@(Result a) : rest) = (a, r) : unPcnt rest
378 unPcnt (_ : rest) = unPcnt rest
381 logHeaders :: [String] -> HtmlTable
383 = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
385 mkTable :: HtmlTable -> Html
386 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
388 tabHeader :: [String] -> HtmlTable
390 = (td <! [align "left", width "100"] << bold << "Program")
393 multiTabHeader :: [String] -> HtmlTable
395 = (td <! [align "left", width "100"] << bold << "Program")
396 <-> (td <! [align "left", width "100"] << bold << "Module")
399 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
400 calcColor :: Int -> String
401 calcColor percentage | percentage >= 0 = printf "#%02x0000" val
402 | otherwise = printf "#0000%02x" val
403 where val = abs percentage * 255 `div` 100
405 -----------------------------------------------------------------------------
406 -- LaTeX table generation (just the summary for now)
408 latexOutput :: [ResultTable] -> Maybe String -> [String] -> [PerProgTableSpec]
409 -> Maybe [String] -> Normalise -> String
411 latexOutput results (Just table_name) _ _ _ norm
413 table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab,
417 [] -> error ("can't find table named: " ++ table_name)
418 (spec:_) -> latexProgTable results spec norm "\n"
420 latexOutput results Nothing _ summary_spec summary_rows _ =
421 (if (length results == 2)
422 then ascii_summary_table True results summary_spec summary_rows
427 latexProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> ShowS
428 latexProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm
429 = latex_show_results results get_result get_status result_ok norm
434 -> (Results -> Maybe a)
435 -> (Results -> Status)
440 latex_show_results [] _ _ _ _
441 = error "latex_show_results: Can't happen?"
442 latex_show_results (r:rs) f stat _result_ok norm
444 [ TableRow (BoxString prog : boxes) |
445 (prog,boxes) <- results_per_prog ] ++
446 if nodevs then [] else
448 TableRow (BoxString "Min" : mins),
449 TableRow (BoxString "Max" : maxs),
450 TableRow (BoxString "Geometric Mean" : gms) ]
452 -- results_per_prog :: [ (String,[BoxValue a]) ]
453 results_per_prog = [ (prog,tail xs) | (prog,xs) <- map calc (Map.toList r) ]
454 calc = calc_result rs f stat (const True) (normalise norm)
456 results_per_run = transpose (map snd results_per_prog)
457 (_lows,gms,_highs) = unzip3 (map calc_gmsd results_per_run)
458 (mins, maxs) = unzip (map calc_minmax results_per_run)
460 normalise :: Result a => Normalise -> a -> a -> BoxValue
461 normalise norm = case norm of
462 NormalisePercent -> convert_to_percentage
463 NormaliseRatio -> normalise_to_base
464 NormaliseNone -> \_base res -> toBox res
466 -----------------------------------------------------------------------------
467 -- ASCII page generation
469 asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String]
472 asciiPage results args summary_spec summary_rows norm =
475 -- only show the summary table if we're comparing two runs
476 . (if (length results == 2)
477 then ascii_summary_table False results summary_spec summary_rows . str "\n\n"
479 . interleave "\n\n" (map (asciiGenProgTable results args norm) per_prog_result_tab)
481 . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab)
484 asciiGenProgTable :: [ResultTable] -> [String] -> Normalise -> PerProgTableSpec -> ShowS
485 asciiGenProgTable results args norm (SpecP long_name _ _ get_result get_status result_ok)
488 . ascii_show_results results args get_result get_status result_ok norm
490 asciiGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> ShowS
491 asciiGenModTable results args (SpecM long_name _ get_result result_ok)
494 . ascii_show_multi_results results args get_result result_ok
496 ascii_header :: Int -> [String] -> ShowS
498 = str "\n-------------------------------------------------------------------------------\n"
499 . str (rjustify 15 "Program")
501 . foldr (.) id (map (str . rjustify w) ss)
502 . str "\n-------------------------------------------------------------------------------\n"
508 -> (Results -> Maybe a)
509 -> (Results -> Status)
514 ascii_show_results [] _ _ _ _ _
515 = error "ascii_show_results: Can't happen?"
516 ascii_show_results (r:rs) ss f stat result_ok norm
517 = ascii_header fIELD_WIDTH ss
518 . interleave "\n" (map show_per_prog_results results_per_prog)
521 . show_per_prog_results ("-1 s.d.",lows)
523 . show_per_prog_results ("+1 s.d.",highs)
525 . show_per_prog_results ("Average",gms)
527 -- results_per_prog :: [ (String,[BoxValue a]) ]
528 results_per_prog = map (calc_result rs f stat result_ok (normalise norm)) (Map.toList r)
530 results_per_run = transpose (map snd results_per_prog)
531 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
533 -- A summary table, useful only when we are comparing two runs. This table
534 -- shows a number of different result categories, one per column.
536 :: Bool -- generate a LaTeX table?
538 -> [PerProgTableSpec]
541 ascii_summary_table _ [] _ _
542 = error "ascii_summary_table: Can't happen?"
543 ascii_summary_table _ [_] _ _
544 = error "ascii_summary_table: Can't happen?"
545 ascii_summary_table latex (r1:r2:_) specs mb_restrict
546 | latex = makeLatexTable (rows ++ TableLine : av_rows)
548 makeTable (table_layout (length specs) w)
549 (TableLine : TableRow header_row :
553 header_row = BoxString "Program" : map BoxString headings
555 (headings, columns, av_cols) = unzip3 (map calc_col specs)
556 av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]
557 baseline = Map.toList r1
558 progs = map BoxString (Map.keys r1)
559 rows0 = map TableRow (zipWith (:) progs (transpose columns))
561 rows1 = restrictRows mb_restrict rows0
563 rows | latex = mungeForLaTeX rows1
566 av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
569 calc_col (SpecP _ heading _ getr gets ok)
570 -- throw away the baseline result
571 = (heading, column, [column_min, column_max, column_mean])
572 where (_, boxes) = unzip (map calc_one_result baseline)
573 calc_one_result = calc_result [r2] getr gets ok convert_to_percentage
574 column = map (\(_:b:_) -> b) boxes
575 (_, column_mean, _) = calc_gmsd column
576 (column_min, column_max) = calc_minmax column
578 restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
579 restrictRows Nothing rows = rows
580 restrictRows (Just these) rows = filter keep_it rows
581 where keep_it (TableRow (BoxString s: _)) = s `elem` these
582 keep_it TableLine = True
585 mungeForLaTeX :: [TableRow] -> [TableRow]
586 mungeForLaTeX = map transrow
588 transrow (TableRow boxes) = TableRow (map transbox boxes)
591 transbox (BoxString s) = BoxString (foldr transchar "" s)
594 transchar '_' s = '\\':'_':s
597 table_layout :: Int -> Int -> Layout
598 table_layout n w boxes = foldr (.) id $ zipWith ($) fns boxes
599 where fns = (str . rjustify 15 . show ) :
600 (\s -> str (space 5) . str (rjustify w (show s))) :
601 replicate (n-1) (str . rjustify w . show)
603 ascii_show_multi_results
607 -> (Results -> Map String a)
611 ascii_show_multi_results [] _ _ _
612 = error "ascii_show_multi_results: Can't happen?"
613 ascii_show_multi_results (r:rs) ss f result_ok
614 = ascii_header fIELD_WIDTH ss
615 . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
619 . show_per_prog_results ("-1 s.d.",lows)
621 . show_per_prog_results ("+1 s.d.",highs)
623 . show_per_prog_results ("Average",gms)
625 base_results = Map.toList r :: [(String,Results)]
627 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
628 results_per_prog_mod_run = map get_results_for_prog base_results
630 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
631 get_results_for_prog (prog, results)
632 = (prog, map get_results_for_mod (Map.toList (f results)))
634 where fms = map get_run_results rs
636 get_run_results fm = case Map.lookup prog fm of
640 get_results_for_mod id_attr
641 = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
643 show_results_for_prog (prog,mrs) =
644 str ("\n"++prog++"\n")
646 str "(no modules compiled)\n"
648 interleave "\n" (map show_per_prog_results mrs))
650 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
652 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
655 show_per_prog_results :: (String, [BoxValue]) -> ShowS
656 show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
658 show_per_prog_results_width :: Int -> (String, [BoxValue]) -> ShowS
659 show_per_prog_results_width w (prog,results)
660 = str (rjustify 15 prog)
662 . foldr (.) id (map (str . rjustify w . showBox) results)
664 -- -----------------------------------------------------------------------------
667 csvTable :: [ResultTable] -> String -> Normalise -> String
668 csvTable results table_name norm
670 table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab,
674 [] -> error ("can't find table named: " ++ table_name)
675 (spec:_) -> csvProgTable results spec norm "\n"
677 csvProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> ShowS
678 csvProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm
679 = csv_show_results results get_result get_status result_ok norm
684 -> (Results -> Maybe a)
685 -> (Results -> Status)
690 csv_show_results [] _ _ _ _
691 = error "csv_show_results: Can't happen?"
692 csv_show_results (r:rs) f stat _result_ok norm
693 = interleave "\n" results_per_prog
695 -- results_per_prog :: [ (String,[BoxValue a]) ]
696 results_per_prog = map (result_line . calc) (Map.toList r)
697 calc = calc_result rs f stat (const True) (normalise norm)
699 result_line (prog,boxes) = interleave "," (str prog : map (str.showBox) boxes)
701 -- ---------------------------------------------------------------------------
702 -- Generic stuff for results generation
704 -- calc_result is a nice exercise in higher-order programming...
707 => [Map String b] -- accumulated results
708 -> (b -> Maybe a) -- get a result from the b
709 -> (b -> Status) -- get a status from the b
710 -> (a -> Bool) -- normalise against the baseline?
711 -> (a -> a -> BoxValue) -- how to normalise
712 -> (String,b) -- the baseline result
713 -> (String,[BoxValue])
715 calc_result rts get_maybe_a get_stat base_ok norm_fn (prog,base_r) =
716 (prog, (just_result m_baseline base_stat :
719 rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
721 get_stuff Nothing = (Nothing, NotDone)
722 get_stuff (Just r) = (get_maybe_a r, get_stat r)
726 Just baseline | base_ok baseline
727 -> map (\(r,s) -> do_norm r s baseline) rts'
729 -> map (\(r,s) -> just_result r s) rts'
732 m_baseline = get_maybe_a base_r
733 base_stat = get_stat base_r
735 just_result Nothing s = RunFailed s
736 just_result (Just a) _ = toBox a
738 do_norm Nothing s _ = RunFailed s
739 do_norm (Just a) _ baseline = norm_fn baseline a
741 -----------------------------------------------------------------------------
742 -- Calculating geometric means and standard deviations
745 This is done using the log method, to avoid needing really large
746 intermediate results. The formula for a geometric mean is
748 (a1 * .... * an) ^ 1/n
750 which is equivalent to
752 e ^ ( (log a1 + ... + log an) / n )
754 where log is the natural logarithm function.
756 Similarly, to compute the geometric standard deviation we compute the
757 deviation of each log, take the root-mean-square, and take the
760 e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
762 where lbar is the mean log,
764 (log a1 + ... + log an) / n
766 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
767 not subtract 100 from gm before performing this calculation.
769 We therefore return a (low, mean, high) triple.
773 calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
775 | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
776 | otherwise = let sqr x = x * x
777 len = fromIntegral (length percentages)
778 logs = map log percentages
779 lbar = sum logs / len
780 st_devs = map (sqr . (lbar-)) logs
781 dbar = sum st_devs / len
783 sdf = exp (sqrt dbar)
785 (Percentage (gm/sdf),
789 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
790 -- can't do log(0.0), so exclude zeros
791 -- small values have inordinate effects so cap at -95%.
793 calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
795 | null percentages = (RunFailed NotDone, RunFailed NotDone)
796 | otherwise = (Percentage (minimum percentages),
797 Percentage (maximum percentages))
799 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
802 -----------------------------------------------------------------------------
805 convert_to_percentage :: Result a => a -> a -> BoxValue
806 convert_to_percentage 0 _val = Percentage 100
807 convert_to_percentage baseline val = Percentage ((realToFrac val / realToFrac baseline) * 100)
809 normalise_to_base :: Result a => a -> a -> BoxValue
810 normalise_to_base 0 _val = BoxFloat 1
811 normalise_to_base baseline val = BoxFloat (realToFrac baseline / realToFrac val)
813 class Real a => Result a where
814 toBox :: a -> BoxValue
816 -- We assume an Int is a size, and print it in kilobytes.
818 instance Result Int where
821 instance Result Integer where
824 instance Result Float where
827 -- -----------------------------------------------------------------------------
830 -- The contents of a box in a table
839 showBox :: BoxValue -> String
840 showBox (RunFailed stat) = show_stat stat
841 showBox (Percentage f) = case printf "%.1f%%" (f-100) of
844 showBox (BoxFloat f) = printf "%.2f" f
845 showBox (BoxInt n) = show (n `div` 1024) ++ "k"
846 showBox (BoxInteger n) = show (n `div` 1024) ++ "k"
847 showBox (BoxString s) = s
849 instance Show BoxValue where
852 show_stat :: Status -> String
853 show_stat Success = "(no result)"
854 show_stat WrongStdout = "(stdout)"
855 show_stat WrongStderr = "(stderr)"
856 show_stat (Exit x) = "exit(" ++ show x ++")"
857 show_stat OutOfHeap = "(heap)"
858 show_stat OutOfStack = "(stack)"
859 show_stat NotDone = "-----"
861 -- -----------------------------------------------------------------------------
865 = TableRow [BoxValue]
868 type Layout = [BoxValue] -> ShowS
870 makeTable :: Layout -> [TableRow] -> ShowS
871 makeTable layout = interleave "\n" . map do_row
872 where do_row (TableRow boxes) = layout boxes
873 do_row TableLine = str (take 80 (repeat '-'))
875 makeLatexTable :: [TableRow] -> ShowS
876 makeLatexTable = foldr (.) id . map do_row
877 where do_row (TableRow boxes)
878 = latexTableLayout boxes . str "\\\\\n"
882 latexTableLayout :: Layout
883 latexTableLayout boxes =
884 foldr (.) id . intersperse (str " & ") . map abox $ boxes
886 abox (RunFailed NotDone) = id
887 abox s = str (foldr transchar "" (show s))
889 transchar '%' s = s -- leave out the percentage signs
890 transchar c s = c : s
892 -- -----------------------------------------------------------------------------
895 split :: Char -> String -> [String]
896 split c s = case break (==c) s of
900 _:rest' -> chunk : split c rest'
902 str :: String -> ShowS
905 interleave :: String -> [ShowS] -> ShowS
906 interleave s = foldr1 (\a b -> a . str s . b)
911 -----------------------------------------------------------------------------