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 ((!))
15 import qualified Text.Html as Html ((!))
16 import qualified Data.Map as Map
18 import System.Console.GetOpt
19 import System.Exit ( exitWith, ExitCode(..) )
21 import Numeric ( showFloat, showFFloat, showSigned )
23 import Data.Maybe ( isNothing )
30 -----------------------------------------------------------------------------
34 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
36 usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
40 when (not (null cmdline_errors) || OptHelp `elem` flags) $
41 die (concat cmdline_errors ++ usageInfo usageHeader argInfo)
43 let { html = OptHTMLOutput `elem` flags;
44 latex = OptLaTeXOutput `elem` flags;
45 ascii = OptASCIIOutput `elem` flags
48 when (ascii && html) $ die "Can't produce both ASCII and HTML"
49 when (devs && nodevs) $ die "Can't both display and hide deviations"
51 results <- parse_logs other_args
53 summary_spec <- case [ cols | OptColumns cols <- flags ] of
54 [] -> return (pickSummary results)
55 (cols:_) -> namedColumns (split ',' cols)
57 let summary_rows = case [ rows | OptRows rows <- flags ] of
59 rows -> Just (split ',' (last rows))
61 let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
64 sequence_ [ checkTimes prog res | table <- results,
65 (prog,res) <- Map.toList table ]
69 putStr (renderHtml (htmlPage results column_headings))
71 putStr (latexOutput results column_headings summary_spec summary_rows)
73 putStr (asciiPage results column_headings summary_spec summary_rows)
76 parse_logs :: [String] -> IO [ResultTable]
78 f <- hGetContents stdin
80 parse_logs log_files =
81 mapM (\f -> do h <- openFile f ReadMode
83 return (parse_log c)) log_files
85 -----------------------------------------------------------------------------
86 -- List of tables we're going to generate
88 data PerProgTableSpec =
89 forall a . Result a =>
91 String -- Name of the table
92 String -- Short name (for column heading)
93 String -- HTML tag for the table
94 (Results -> Maybe a) -- How to get the result
95 (Results -> Status) -- How to get the status of this result
96 (a -> Bool) -- Result within reasonable limits?
98 data PerModuleTableSpec =
99 forall a . Result a =>
101 String -- Name of the table
102 String -- HTML tag for the table
103 (Results -> Map String a) -- get the module map
104 (a -> Bool) -- Result within reasonable limits?
106 -- The various per-program aspects of execution that we can generate results for.
107 size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
108 alloc_spec = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok
109 runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok
110 muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok
111 gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok
112 gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok
113 instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
114 mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
115 mwrite_spec = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok
116 cmiss_spec = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok
131 namedColumns :: [String] -> IO [PerProgTableSpec]
132 namedColumns ss = mapM findSpec ss
134 case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
136 [] -> die ("unknown column: " ++ s)
137 (spec:_) -> return spec
139 mean :: (Results -> [Float]) -> Results -> Maybe Float
140 mean f results = go (f results)
141 where go [] = Nothing
142 go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs))
144 -- Look for bogus-looking times: On Linux we occasionally get timing results
145 -- that are bizarrely low, and skew the average.
146 checkTimes :: String -> Results -> IO ()
147 checkTimes prog results = do
148 check "run time" (run_time results)
149 check "mut time" (mut_time results)
150 check "GC time" (gc_time results)
154 hPutStrLn stderr ("warning: dubious " ++ kind
155 ++ " results for " ++ prog
157 | otherwise = return ()
158 where strange t = any (\r -> time_ok r && r / t > 1.4) ts
159 -- looks for times that are >40% smaller than
163 -- These are the per-prog tables we want to generate
164 per_prog_result_tab =
165 [ size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec,
166 gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ]
168 -- A single summary table, giving comparison figures for a number of
169 -- aspects, each in its own column. Only works when comparing two runs.
170 normal_summary_specs =
171 [ size_spec, alloc_spec, runtime_spec ]
173 cachegrind_summary_specs =
174 [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
176 -- Pick an appropriate summary table: if we're cachegrinding, then
177 -- we're probably not interested in the runtime, but we are interested
178 -- in instructions, mem reads and mem writes (and vice-versa).
179 pickSummary :: [ResultTable] -> [PerProgTableSpec]
181 | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
182 | otherwise = cachegrind_summary_specs
184 per_module_result_tab =
185 [ SpecM "Module Sizes" "mod-sizes" module_size always_ok
186 , SpecM "Compile Times" "compile-time" compile_time time_ok
189 always_ok :: a -> Bool
190 always_ok = const True
192 time_ok :: Float -> Bool
193 time_ok t = t > tooquick_threshold
195 -----------------------------------------------------------------------------
196 -- HTML page generation
198 --htmlPage :: Results -> [String] -> Html
199 htmlPage results args
200 = header << thetitle << reportTitle
202 +++ h1 << reportTitle
205 +++ body (gen_tables results args)
207 gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
208 ++ map (module_menu_item) per_module_result_tab)
210 prog_menu_item (SpecP name _ anc _ _ _) = anchor <! [href ('#':anc)] << name
211 module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
213 gen_tables results args =
214 foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
215 +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
217 htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
218 = sectHeading title anc
219 +++ font <! [size "1"]
220 << mkTable (htmlShowResults results args get_result get_status result_ok)
223 htmlGenModTable results args (SpecM title anc get_result result_ok)
224 = sectHeading title anc
225 +++ font <![size "1"]
226 << mkTable (htmlShowMultiResults results args get_result result_ok)
229 sectHeading :: String -> String -> Html
230 sectHeading s nm = h2 << anchor <! [name nm] << s
236 -> (Results -> Maybe a)
237 -> (Results -> Status)
241 htmlShowResults (r:rs) ss f stat result_ok
243 </> aboves (zipWith tableRow [1..] results_per_prog)
244 </> aboves ((if nodevs then []
245 else [tableRow (-1) ("-1 s.d.", lows),
246 tableRow (-1) ("+1 s.d.", highs)])
247 ++ [tableRow (-1) ("Average", gms)])
249 -- results_per_prog :: [ (String,[BoxValue a]) ]
250 results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
252 results_per_run = transpose (map snd results_per_prog)
253 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
259 -> (Results -> Map String a)
263 htmlShowMultiResults (r:rs) ss f result_ok =
265 </> aboves (map show_results_for_prog results_per_prog_mod_run)
266 </> aboves ((if nodevs then []
267 else [td << bold << "-1 s.d."
268 <-> tableRow (-1) ("", lows),
269 td << bold << "+1 s.d."
270 <-> tableRow (-1) ("", highs)])
271 ++ [td << bold << "Average"
272 <-> tableRow (-1) ("", gms)])
275 base_results = Map.toList r :: [(String,Results)]
277 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
278 results_per_prog_mod_run = map get_results_for_prog base_results
280 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
281 get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r)))
283 where fms = map get_run_results rs
285 get_run_results fm = case Map.lookup prog fm of
289 get_results_for_mod (id,attr) = calc_result fms Just (const Success)
292 show_results_for_prog (prog,mrs) =
293 td <! [valign "top"] << bold << prog
294 <-> (if null mrs then
295 td << "(no modules compiled)"
297 toHtml (aboves (map (tableRow 0) mrs)))
299 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
301 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
303 tableRow :: Int -> (String, [BoxValue]) -> HtmlTable
304 tableRow row_no (prog, results)
305 = td <! [bgcolor left_column_color] << prog
306 <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
308 where clr | row_no < 0 = bgcolor average_row_color
309 | even row_no = bgcolor even_row_color
310 | otherwise = bgcolor odd_row_color
312 left_column_color = "#d0d0ff" -- light blue
313 odd_row_color = "#d0d0ff" -- light blue
314 even_row_color = "#f0f0ff" -- v. light blue
315 average_row_color = "#ffd0d0" -- light red
318 findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
319 findBest stuff@(Result base : rest)
320 = map (\a -> (a==base, a))
322 best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
324 no_pcnt_stuff = map unPcnt stuff
326 unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
327 unPcnt (r@(Result a) : rest) = (a, r) : unPcnt rest
328 unPcnt (_ : rest) = unPcnt rest
332 = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
334 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
337 = (td <! [align "left", width "100"] << bold << "Program")
341 = (td <! [align "left", width "100"] << bold << "Program")
342 <-> (td <! [align "left", width "100"] << bold << "Module")
345 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
347 calcColor :: Int -> String
348 calcColor p | p >= 0 = "#" ++ (showHex red 2 "0000")
349 | otherwise = "#0000" ++ (showHex blue 2 "")
350 where red = p * 255 `div` 100
351 blue = (-p) * 255 `div` 100
353 showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s
354 showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s)
356 hexDig i | i > 10 = chr (i-10 + ord 'a')
357 | otherwise = chr (i + ord '0')
359 -----------------------------------------------------------------------------
360 -- LaTeX table generation (just the summary for now)
362 latexOutput results args summary_spec summary_rows =
363 (if (length results == 2)
364 then ascii_summary_table True results summary_spec summary_rows
369 -----------------------------------------------------------------------------
370 -- ASCII page generation
372 asciiPage results args summary_spec summary_rows =
375 -- only show the summary table if we're comparing two runs
376 . (if (length results == 2)
377 then ascii_summary_table False results summary_spec summary_rows . str "\n\n"
379 . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
381 . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab)
384 asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
387 . ascii_show_results results args get_result get_status result_ok
389 asciiGenModTable results args (SpecM title anc get_result result_ok)
392 . ascii_show_multi_results results args get_result result_ok
394 ascii_header width ss
395 = str "\n-------------------------------------------------------------------------------\n"
396 . str (rjustify 15 "Program")
398 . foldr (.) id (map (str . rjustify width) ss)
399 . str "\n-------------------------------------------------------------------------------\n"
405 -> (Results -> Maybe a)
406 -> (Results -> Status)
410 ascii_show_results (r:rs) ss f stat result_ok
411 = ascii_header fIELD_WIDTH ss
412 . interleave "\n" (map show_per_prog_results results_per_prog)
415 . show_per_prog_results ("-1 s.d.",lows)
417 . show_per_prog_results ("+1 s.d.",highs)
419 . show_per_prog_results ("Average",gms)
421 -- results_per_prog :: [ (String,[BoxValue a]) ]
422 results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
424 results_per_run = transpose (map snd results_per_prog)
425 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
427 -- A summary table, useful only when we are comparing two runs. This table
428 -- shows a number of different result categories, one per column.
430 :: Bool -- generate a LaTeX table?
432 -> [PerProgTableSpec]
435 ascii_summary_table latex (r1:r2:_) specs mb_restrict
436 | latex = makeLatexTable (rows ++ TableLine : av_rows)
438 makeTable (table_layout (length specs) width)
439 (TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows)
441 header = BoxString "Program" : map BoxString headings
443 (headings, columns, av_cols) = unzip3 (map calc_col specs)
444 av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]
445 baseline = Map.toList r1
446 progs = map BoxString (Map.keys r1)
447 rows0 = map TableRow (zipWith (:) progs (transpose columns))
449 rows1 = restrictRows mb_restrict rows0
451 rows | latex = mungeForLaTeX rows1
454 av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
457 calc_col (SpecP _ heading _ getr gets ok)
458 = (heading, column, [min,max,mean]) -- throw away the baseline result
459 where (_, boxes) = unzip (map calc_one_result baseline)
460 calc_one_result = calc_result [r2] getr gets ok
461 column = map (\(_:b:_) -> b) boxes
462 (_,mean,_) = calc_gmsd column
463 (min,max) = calc_minmax column
465 restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
466 restrictRows Nothing rows = rows
467 restrictRows (Just these) rows = filter keep_it rows
468 where keep_it (TableRow (BoxString s: _)) = s `elem` these
469 keep_it TableLine = True
472 mungeForLaTeX :: [TableRow] -> [TableRow]
473 mungeForLaTeX = map transrow
475 transrow (TableRow boxes) = TableRow (map transbox boxes)
478 transbox (BoxString s) = BoxString (foldr transchar "" s)
481 transchar '_' s = '\\':'_':s
484 table_layout n width =
485 (str . rjustify 15) :
486 (\s -> str (space 5) . str (rjustify width s)) :
487 replicate (n-1) (str . rjustify width)
489 ascii_show_multi_results
493 -> (Results -> Map String a)
497 ascii_show_multi_results (r:rs) ss f result_ok
498 = ascii_header fIELD_WIDTH ss
499 . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
503 . show_per_prog_results ("-1 s.d.",lows)
505 . show_per_prog_results ("+1 s.d.",highs)
507 . show_per_prog_results ("Average",gms)
509 base_results = Map.toList r :: [(String,Results)]
511 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
512 results_per_prog_mod_run = map get_results_for_prog base_results
514 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
515 get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r)))
517 where fms = map get_run_results rs
519 get_run_results fm = case Map.lookup prog fm of
523 get_results_for_mod (id,attr) = calc_result fms Just (const Success)
526 show_results_for_prog (prog,mrs) =
527 str ("\n"++prog++"\n")
529 str "(no modules compiled)\n"
531 interleave "\n" (map show_per_prog_results mrs))
533 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
535 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
538 show_per_prog_results :: (String, [BoxValue]) -> ShowS
539 show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
541 show_per_prog_results_width width (prog,results)
542 = str (rjustify 15 prog)
544 . foldr (.) id (map (str . rjustify width . showBox) results)
546 -- ---------------------------------------------------------------------------
547 -- Generic stuff for results generation
549 -- calc_result is a nice exercise in higher-order programming...
552 => [Map String b] -- accumulated results
553 -> (b -> Maybe a) -- get a result from the b
554 -> (b -> Status) -- get a status from the b
555 -> (a -> Bool) -- is this result ok?
556 -> (String,b) -- the baseline result
557 -> (String,[BoxValue])
559 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
560 (prog, (just_result baseline base_stat :
563 rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
565 get_stuff Nothing = (Nothing, NotDone)
566 get_stuff (Just r) = (get_maybe_a r, get_stat r)
570 Just base | result_ok base
571 -> map (\(r,s) -> percentage r s base) rts'
573 -> map (\(r,s) -> just_result r s) rts'
576 baseline = get_maybe_a base_r
577 base_stat = get_stat base_r
579 just_result Nothing s = RunFailed s
580 just_result (Just a) s = toBox a
582 percentage Nothing s base = RunFailed s
583 percentage (Just a) s base = Percentage
584 (convert_to_percentage base a)
585 -----------------------------------------------------------------------------
586 -- Calculating geometric means and standard deviations
589 This is done using the log method, to avoid needing really large
590 intermediate results. The formula for a geometric mean is
592 (a1 * .... * an) ^ 1/n
594 which is equivalent to
596 e ^ ( (log a1 + ... + log an) / n )
598 where log is the natural logarithm function.
600 Similarly, to compute the geometric standard deviation we compute the
601 deviation of each log, take the root-mean-square, and take the
604 e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
606 where lbar is the mean log,
608 (log a1 + ... + log an) / n
610 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
611 not subtract 100 from gm before performing this calculation.
613 We therefore return a (low, mean, high) triple.
617 calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
619 | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
620 | otherwise = let sqr x = x * x
621 len = fromIntegral (length percentages)
622 logs = map log percentages
623 lbar = sum logs / len
624 devs = map (sqr . (lbar-)) logs
625 dbar = sum devs / len
627 sdf = exp (sqrt dbar)
629 (Percentage (gm/sdf),
633 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
634 -- can't do log(0.0), so exclude zeros
635 -- small values have inordinate effects so cap at -95%.
637 calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
639 | null percentages = (RunFailed NotDone, RunFailed NotDone)
640 | otherwise = (Percentage (minimum percentages),
641 Percentage (maximum percentages))
643 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
646 -----------------------------------------------------------------------------
649 class Num a => Result a where
650 toBox :: a -> BoxValue
651 convert_to_percentage :: a -> a -> Float
653 -- We assume an Int is a size, and print it in kilobytes.
655 instance Result Int where
656 convert_to_percentage 0 size = 100
657 convert_to_percentage base size = (fromIntegral size / fromIntegral base) * 100
661 instance Result Integer where
662 convert_to_percentage 0 size = 100
663 convert_to_percentage base size = (fromInteger size / fromInteger base) * 100
667 instance Result Float where
668 convert_to_percentage 0.0 size = 100.0
669 convert_to_percentage base size = size / base * 100
673 -- -----------------------------------------------------------------------------
676 -- The contents of a box in a table
685 showBox :: BoxValue -> String
686 showBox (RunFailed stat) = show_stat stat
687 showBox (Percentage f) = show_pcntage f
688 showBox (BoxFloat f) = printf "%.2f" f
689 showBox (BoxInt n) = show (n `div` 1024) ++ "k"
690 showBox (BoxInteger n) = show (n `div` 1024) ++ "k"
691 showBox (BoxString s) = s
693 instance Show BoxValue where { show = showBox }
695 show_pcntage n = show_float_signed (n-100) ++ "%"
698 | n >= 0 = printf "+%.1f" n
699 | otherwise = printf "%.1f" n
701 show_stat Success = "(no result)"
702 show_stat WrongStdout = "(stdout)"
703 show_stat WrongStderr = "(stderr)"
704 show_stat (Exit x) = "exit(" ++ show x ++")"
705 show_stat OutOfHeap = "(heap)"
706 show_stat OutOfStack = "(stack)"
707 show_stat NotDone = "-----"
709 -- -----------------------------------------------------------------------------
713 = TableRow [BoxValue]
716 type Layout = [String -> ShowS]
718 makeTable :: Layout -> [TableRow] -> ShowS
719 makeTable p = interleave "\n" . map do_row
720 where do_row (TableRow boxes) = applyLayout p boxes
721 do_row TableLine = str (take 80 (repeat '-'))
723 makeLatexTable :: [TableRow] -> ShowS
724 makeLatexTable = foldr (.) id . map do_row
725 where do_row (TableRow boxes)
726 = applyLayout latexTableLayout boxes . str "\\\\\n"
730 latexTableLayout :: Layout
731 latexTableLayout = box : repeat (box . (" & "++))
732 where box s = str (foldr transchar "" s)
734 transchar '%' s = s -- leave out the percentage signs
735 transchar c s = c : s
737 applyLayout :: Layout -> [BoxValue] -> ShowS
738 applyLayout layout values =
739 foldr (.) id [ f (show val) | (val,f) <- zip values layout ]
741 -- -----------------------------------------------------------------------------
744 split :: Char -> String -> [String]
745 split c s = case rest of
747 _:rest -> chunk : split c rest
748 where (chunk, rest) = break (==c) s
752 interleave s = foldr1 (\a b -> a . str s . b)
754 fIELD_WIDTH = 16 :: Int
756 -----------------------------------------------------------------------------