1 -----------------------------------------------------------------------------
2 -- $Id: Main.hs,v 1.9 2004/04/02 14:28:57 simonmar Exp $
4 -- (c) Simon Marlow 1997-1999
5 -----------------------------------------------------------------------------
14 import Html hiding ((!))
15 import qualified Html ((!))
20 import Maybe ( isNothing )
25 import Data.List (foldl')
29 -----------------------------------------------------------------------------
33 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
35 usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
39 if not (null cmdline_errors) || OptHelp `elem` flags
40 then die (concat cmdline_errors ++ usageInfo usageHeader argInfo)
43 let { html = OptHTMLOutput `elem` flags;
44 latex = OptLaTeXOutput `elem` flags;
45 ascii = OptASCIIOutput `elem` flags
49 then die "Can't produce both ASCII and HTML"
53 then die "Can't both display and hide deviations"
56 results <- parse_logs other_args
58 let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
61 _ | html -> putStr (renderHtml (htmlPage results column_headings))
62 _ | latex -> putStr (latexOutput results column_headings)
63 _ | otherwise -> putStr (asciiPage results column_headings)
66 parse_logs :: [String] -> IO [ResultTable]
68 f <- hGetContents stdin
70 parse_logs log_files =
71 mapM (\f -> do h <- openFile f ReadMode
73 return (parse_log c)) log_files
75 -----------------------------------------------------------------------------
76 -- List of tables we're going to generate
78 data PerProgTableSpec =
79 forall a . Result a =>
81 String -- Name of the table
82 String -- Short name (for column heading)
83 String -- HTML tag for the table
84 (Results -> Maybe a) -- How to get the result
85 (Results -> Status) -- How to get the status of this result
86 (a -> Bool) -- Result within reasonable limits?
88 data PerModuleTableSpec =
89 forall a . Result a =>
91 String -- Name of the table
92 String -- HTML tag for the table
93 (Results -> FiniteMap String a) -- get the module map
94 (a -> Bool) -- Result within reasonable limits?
96 -- The various per-program aspects of execution that we can generate results for.
97 size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
98 alloc_spec = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok
99 runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok
100 muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok
101 gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok
102 gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok
103 instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
104 mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
105 mwrite_spec = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok
106 cmiss_spec = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok
108 mean :: (Results -> [Float]) -> Results -> Maybe Float
109 mean f results = go (f results)
110 where go [] = Nothing
111 go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs))
113 -- These are the per-prog tables we want to generate
114 per_prog_result_tab =
115 [ size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec,
116 gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ]
118 -- A single summary table, giving comparison figures for a number of
119 -- aspects, each in its own column. Only works when comparing two runs.
120 normal_summary_specs =
121 [ size_spec, alloc_spec, runtime_spec ]
123 cachegrind_summary_specs =
124 [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
126 latex_summary_specs = [ size_spec, instrs_spec, mreads_spec, mwrite_spec ]
128 -- Pick an appropriate summary table: if we're cachegrinding, then
129 -- we're probably not interested in the runtime, but we are interested
130 -- in instructions, mem reads and mem writes (and vice-versa).
131 pickSummary :: [ResultTable] -> [PerProgTableSpec]
133 | isNothing (instrs (head (eltsFM (head rs)))) = normal_summary_specs
134 | otherwise = cachegrind_summary_specs
136 per_module_result_tab =
137 [ SpecM "Module Sizes" "mod-sizes" module_size always_ok
138 , SpecM "Compile Times" "compile-time" compile_time time_ok
141 always_ok :: a -> Bool
142 always_ok = const True
144 time_ok :: Float -> Bool
145 time_ok t = t > tooquick_threshold
147 -----------------------------------------------------------------------------
148 -- HTML page generation
150 --htmlPage :: Results -> [String] -> Html
151 htmlPage results args
152 = header << thetitle << reportTitle
154 +++ h1 << reportTitle
157 +++ body (gen_tables results args)
159 gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
160 ++ map (module_menu_item) per_module_result_tab)
162 prog_menu_item (SpecP name _ anc _ _ _) = anchor <! [href ('#':anc)] << name
163 module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
165 gen_tables results args =
166 foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
167 +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
169 htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
170 = sectHeading title anc
171 +++ font <! [size "1"]
172 << mkTable (htmlShowResults results args get_result get_status result_ok)
175 htmlGenModTable results args (SpecM title anc get_result result_ok)
176 = sectHeading title anc
177 +++ font <![size "1"]
178 << mkTable (htmlShowMultiResults results args get_result result_ok)
181 sectHeading :: String -> String -> Html
182 sectHeading s nm = h2 << anchor <! [name nm] << s
188 -> (Results -> Maybe a)
189 -> (Results -> Status)
193 htmlShowResults (r:rs) ss f stat result_ok
195 </> aboves (zipWith tableRow [1..] results_per_prog)
196 </> aboves ((if nodevs then []
197 else [tableRow (-1) ("-1 s.d.", lows),
198 tableRow (-1) ("+1 s.d.", highs)])
199 ++ [tableRow (-1) ("Average", gms)])
201 -- results_per_prog :: [ (String,[BoxValue a]) ]
202 results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
204 results_per_run = transpose (map snd results_per_prog)
205 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
211 -> (Results -> FiniteMap String a)
215 htmlShowMultiResults (r:rs) ss f result_ok =
217 </> aboves (map show_results_for_prog results_per_prog_mod_run)
218 </> aboves ((if nodevs then []
219 else [td << bold << "-1 s.d."
220 <-> tableRow (-1) ("", lows),
221 td << bold << "+1 s.d."
222 <-> tableRow (-1) ("", highs)])
223 ++ [td << bold << "Average"
224 <-> tableRow (-1) ("", gms)])
227 base_results = fmToList r :: [(String,Results)]
229 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
230 results_per_prog_mod_run = map get_results_for_prog base_results
232 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
233 get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
235 where fms = map get_run_results rs
237 get_run_results fm = case lookupFM fm prog of
241 get_results_for_mod (id,attr) = calc_result fms Just (const Success)
244 show_results_for_prog (prog,mrs) =
245 td <! [valign "top"] << bold << prog
246 <-> (if null mrs then
247 td << "(no modules compiled)"
249 toHtml (aboves (map (tableRow 0) mrs)))
251 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
253 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
255 tableRow :: Int -> (String, [BoxValue]) -> HtmlTable
256 tableRow row_no (prog, results)
257 = td <! [bgcolor left_column_color] << prog
258 <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
260 where clr | row_no < 0 = bgcolor average_row_color
261 | even row_no = bgcolor even_row_color
262 | otherwise = bgcolor odd_row_color
264 left_column_color = "#d0d0ff" -- light blue
265 odd_row_color = "#d0d0ff" -- light blue
266 even_row_color = "#f0f0ff" -- v. light blue
267 average_row_color = "#ffd0d0" -- light red
270 findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
271 findBest stuff@(Result base : rest)
272 = map (\a -> (a==base, a))
274 best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
276 no_pcnt_stuff = map unPcnt stuff
278 unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
279 unPcnt (r@(Result a) : rest) = (a, r) : unPcnt rest
280 unPcnt (_ : rest) = unPcnt rest
284 = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
286 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
289 = (td <! [align "left", width "100"] << bold << "Program")
293 = (td <! [align "left", width "100"] << bold << "Program")
294 <-> (td <! [align "left", width "100"] << bold << "Module")
297 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
299 calcColor :: Int -> String
300 calcColor p | p >= 0 = "#" ++ (showHex red 2 "0000")
301 | otherwise = "#0000" ++ (showHex blue 2 "")
302 where red = p * 255 `div` 100
303 blue = (-p) * 255 `div` 100
305 showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s
306 showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s)
308 hexDig i | i > 10 = chr (i-10 + ord 'a')
309 | otherwise = chr (i + ord '0')
311 -----------------------------------------------------------------------------
312 -- LaTeX table generation (just the summary for now)
314 latexOutput results args =
315 (if (length results == 2)
316 then ascii_summary_table True results latex_summary_specs . str "\n\n"
320 -----------------------------------------------------------------------------
321 -- ASCII page generation
323 asciiPage results args =
326 -- only show the summary table if we're comparing two runs
327 . (if (length results == 2)
328 then ascii_summary_table False results (pickSummary results) . str "\n\n"
330 . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
332 . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab)
335 asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
338 . ascii_show_results results args get_result get_status result_ok
340 asciiGenModTable results args (SpecM title anc get_result result_ok)
343 . ascii_show_multi_results results args get_result result_ok
345 ascii_header width ss
346 = str "\n-------------------------------------------------------------------------------\n"
347 . str (rjustify 15 "Program")
349 . foldr (.) id (map (str . rjustify width) ss)
350 . str "\n-------------------------------------------------------------------------------\n"
356 -> (Results -> Maybe a)
357 -> (Results -> Status)
361 ascii_show_results (r:rs) ss f stat result_ok
362 = ascii_header fIELD_WIDTH ss
363 . interleave "\n" (map show_per_prog_results results_per_prog)
366 . show_per_prog_results ("-1 s.d.",lows)
368 . show_per_prog_results ("+1 s.d.",highs)
370 . show_per_prog_results ("Average",gms)
372 -- results_per_prog :: [ (String,[BoxValue a]) ]
373 results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
375 results_per_run = transpose (map snd results_per_prog)
376 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
378 -- A summary table, useful only when we are comparing two runs. This table
379 -- shows a number of different result categories, one per column.
381 :: Bool -- generate a LaTeX table?
383 -> [PerProgTableSpec]
385 ascii_summary_table latex (r1:r2:_) specs
386 | latex = makeLatexTable (rows ++ TableLine : av_rows)
388 makeTable (table_layout (length specs) width)
389 (TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows)
391 header = BoxString "Program" : map BoxString headings
393 (headings, columns, av_cols) = unzip3 (map calc_col specs)
394 av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]
395 baseline = fmToList r1
396 progs = map BoxString (keysFM r1)
397 rows' = map TableRow (zipWith (:) progs (transpose columns))
399 rows | latex = mungeForLaTeX rows'
402 av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
405 calc_col (SpecP _ heading _ getr gets ok)
406 = (heading, column, [min,max,mean]) -- throw away the baseline result
407 where (_, boxes) = unzip (map calc_one_result baseline)
408 calc_one_result = calc_result [r2] getr gets ok
409 column = map (\(_:b:_) -> b) boxes
410 (_,mean,_) = calc_gmsd column
411 (min,max) = calc_minmax column
413 mungeForLaTeX :: [TableRow] -> [TableRow]
414 mungeForLaTeX = filter keep_it
415 where keep_it (TableRow (BoxString s: _)) = ok s
416 keep_it TableLine = True
419 ok s = s `elem` progs_to_keep
422 "anna", "cacheprof", "circsim", "compress",
423 "fem", "fulsom", "fibheaps", "hidden",
424 "infer", "typecheck", "scs", "simple"
427 table_layout n width =
428 (str . rjustify 15) :
429 (\s -> str (space 5) . str (rjustify width s)) :
430 replicate (n-1) (str . rjustify width)
432 ascii_show_multi_results
436 -> (Results -> FiniteMap String a)
440 ascii_show_multi_results (r:rs) ss f result_ok
441 = ascii_header fIELD_WIDTH ss
442 . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
446 . show_per_prog_results ("-1 s.d.",lows)
448 . show_per_prog_results ("+1 s.d.",highs)
450 . show_per_prog_results ("Average",gms)
452 base_results = fmToList r :: [(String,Results)]
454 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
455 results_per_prog_mod_run = map get_results_for_prog base_results
457 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
458 get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
460 where fms = map get_run_results rs
462 get_run_results fm = case lookupFM fm prog of
466 get_results_for_mod (id,attr) = calc_result fms Just (const Success)
469 show_results_for_prog (prog,mrs) =
470 str ("\n"++prog++"\n")
472 str "(no modules compiled)\n"
474 interleave "\n" (map show_per_prog_results mrs))
476 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
478 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
481 show_per_prog_results :: (String, [BoxValue]) -> ShowS
482 show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
484 show_per_prog_results_width width (prog,results)
485 = str (rjustify 15 prog)
487 . foldr (.) id (map (str . rjustify width . showBox) results)
489 -- ---------------------------------------------------------------------------
490 -- Generic stuff for results generation
492 -- calc_result is a nice exercise in higher-order programming...
495 => [FiniteMap String b] -- accumulated results
496 -> (b -> Maybe a) -- get a result from the b
497 -> (b -> Status) -- get a status from the b
498 -> (a -> Bool) -- is this result ok?
499 -> (String,b) -- the baseline result
500 -> (String,[BoxValue])
502 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
503 (prog, (just_result baseline base_stat :
506 rts' = map (\rt -> get_stuff (lookupFM rt prog)) rts
508 get_stuff Nothing = (Nothing, NotDone)
509 get_stuff (Just r) = (get_maybe_a r, get_stat r)
513 Just base | result_ok base
514 -> map (\(r,s) -> percentage r s base) rts'
516 -> map (\(r,s) -> just_result r s) rts'
519 baseline = get_maybe_a base_r
520 base_stat = get_stat base_r
522 just_result Nothing s = RunFailed s
523 just_result (Just a) s = toBox a
525 percentage Nothing s base = RunFailed s
526 percentage (Just a) s base = Percentage
527 (convert_to_percentage base a)
528 -----------------------------------------------------------------------------
529 -- Calculating geometric means and standard deviations
532 This is done using the log method, to avoid needing really large
533 intermediate results. The formula for a geometric mean is
535 (a1 * .... * an) ^ 1/n
537 which is equivalent to
539 e ^ ( (log a1 + ... + log an) / n )
541 where log is the natural logarithm function.
543 Similarly, to compute the geometric standard deviation we compute the
544 deviation of each log, take the root-mean-square, and take the
547 e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
549 where lbar is the mean log,
551 (log a1 + ... + log an) / n
553 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
554 not subtract 100 from gm before performing this calculation.
556 We therefore return a (low, mean, high) triple.
560 calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
562 | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
563 | otherwise = let sqr x = x * x
564 len = fromIntegral (length percentages)
565 logs = map log percentages
566 lbar = sum logs / len
567 devs = map (sqr . (lbar-)) logs
568 dbar = sum devs / len
570 sdf = exp (sqrt dbar)
572 (Percentage (gm/sdf),
576 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
577 -- can't do log(0.0), so exclude zeros
578 -- small values have inordinate effects so cap at -95%.
580 calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
582 | null percentages = (RunFailed NotDone, RunFailed NotDone)
583 | otherwise = (Percentage (minimum percentages),
584 Percentage (maximum percentages))
586 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
589 -----------------------------------------------------------------------------
592 class Num a => Result a where
593 toBox :: a -> BoxValue
594 convert_to_percentage :: a -> a -> Float
596 -- We assume an Int is a size, and print it in kilobytes.
598 instance Result Int where
599 convert_to_percentage 0 size = 100
600 convert_to_percentage base size = (fromIntegral size / fromIntegral base) * 100
604 instance Result Integer where
605 convert_to_percentage 0 size = 100
606 convert_to_percentage base size = (fromInteger size / fromInteger base) * 100
610 instance Result Float where
611 convert_to_percentage 0.0 size = 100.0
612 convert_to_percentage base size = size / base * 100
616 -- -----------------------------------------------------------------------------
619 -- The contents of a box in a table
628 showBox :: BoxValue -> String
629 showBox (RunFailed stat) = show_stat stat
630 showBox (Percentage f) = show_pcntage f
631 showBox (BoxFloat f) = showFloat' Nothing (Just 2) f
632 showBox (BoxInt n) = show (n `div` 1024) ++ "k"
633 showBox (BoxInteger n) = show (n `div` 1024) ++ "k"
634 showBox (BoxString s) = s
636 instance Show BoxValue where { show = showBox }
638 show_pcntage n = show_float_signed (n-100) ++ "%"
640 show_float_signed = showFloat False False True False False Nothing (Just 2)
642 show_stat Success = "(no result)"
643 show_stat WrongStdout = "(stdout)"
644 show_stat WrongStderr = "(stderr)"
645 show_stat (Exit x) = "exit(" ++ show x ++")"
646 show_stat OutOfHeap = "(heap)"
647 show_stat OutOfStack = "(stack)"
648 show_stat NotDone = "-----"
650 -- -----------------------------------------------------------------------------
654 = TableRow [BoxValue]
657 type Layout = [String -> ShowS]
659 makeTable :: Layout -> [TableRow] -> ShowS
660 makeTable p = interleave "\n" . map do_row
661 where do_row (TableRow boxes) = applyLayout p boxes
662 do_row TableLine = str (take 80 (repeat '-'))
664 makeLatexTable :: [TableRow] -> ShowS
665 makeLatexTable = foldr (.) id . map do_row
666 where do_row (TableRow boxes)
667 = applyLayout latexTableLayout boxes . str "\\\\\n"
671 latexTableLayout :: Layout
672 latexTableLayout = str : repeat (str . (" & "++))
674 applyLayout :: Layout -> [BoxValue] -> ShowS
675 applyLayout layout values =
676 foldr (.) id [ f (show val) | (val,f) <- zip values layout ]
678 -- -----------------------------------------------------------------------------
683 interleave s = foldr1 (\a b -> a . str s . b)
685 fIELD_WIDTH = 16 :: Int
687 -----------------------------------------------------------------------------