utils/nofib-analyse/Main.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: Main.hs,v 1.10 2005/06/07 10:58:31 simonmar Exp $
   3
   4 -- (c) Simon Marlow 1997-2005
   5 -----------------------------------------------------------------------------
   6
   7 module Main where
   8
   9 import GenUtils
  10 import Slurp
  11 import CmdLine
  12
  13 import Text.Printf
  14 import Text.Html hiding ((!))
  15 import qualified Text.Html as Html ((!))
  16 import qualified Data.Map as Map
  17 import Data.Map (Map)
  18 import System.Console.GetOpt
  19 import System.Exit      ( exitWith, ExitCode(..) )
  20
  21 import Numeric          ( showFloat, showFFloat, showSigned )
  22 import Data.Maybe       ( isNothing )
  23 import Data.Char
  24 import System.IO
  25 import Data.List
  26
  27 (<!) = (Html.!)
  28
  29 -----------------------------------------------------------------------------
  30 -- Top level stuff
  31
  32 die :: String -> IO a
  33 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
  34
  35 usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
  36
  37 main = do
  38
  39  if not (null cmdline_errors) || OptHelp `elem` flags
  40         then die (concat cmdline_errors ++ usageInfo usageHeader argInfo)
  41         else do
  42
  43  let { html  = OptHTMLOutput  `elem` flags;
  44        latex = OptLaTeXOutput `elem` flags;
  45        ascii = OptASCIIOutput `elem` flags
  46      }
  47
  48  if ascii && html
  49         then die "Can't produce both ASCII and HTML"
  50         else do
  51
  52  if devs && nodevs
  53         then die "Can't both display and hide deviations"
  54         else do
  55
  56  results <- parse_logs other_args
  57
  58  summary_spec <- case [ cols | OptColumns cols <- flags ] of
  59                         []       -> return (pickSummary results)
  60                         (cols:_) -> namedColumns (split ',' cols)
  61
  62  let summary_rows = case [ rows | OptRows rows <- flags ] of
  63                         [] -> Nothing
  64                         rows -> Just (split ',' (last rows))
  65
  66  let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
  67
  68  -- sanity check
  69  sequence_ [ checkTimes prog res | table <- results,
  70                                    (prog,res) <- Map.toList table ]
  71
  72  case () of
  73    _ | html      ->
  74         putStr (renderHtml (htmlPage results column_headings))
  75    _ | latex     ->
  76         putStr (latexOutput results column_headings summary_spec summary_rows)
  77    _ | otherwise ->
  78         putStr (asciiPage results column_headings summary_spec summary_rows)
  79
  80
  81 parse_logs :: [String] -> IO [ResultTable]
  82 parse_logs [] = do
  83         f <- hGetContents stdin
  84         return [parse_log f]
  85 parse_logs log_files =
  86         mapM (\f -> do h <- openFile f ReadMode
  87                        c <- hGetContents h
  88                        return (parse_log c)) log_files
  89
  90 -----------------------------------------------------------------------------
  91 -- List of tables we're going to generate
  92
  93 data PerProgTableSpec =
  94         forall a . Result a =>
  95            SpecP
  96                 String                  -- Name of the table
  97                 String                  -- Short name (for column heading)
  98                 String                  -- HTML tag for the table
  99                 (Results -> Maybe a)    -- How to get the result
 100                 (Results -> Status)     -- How to get the status of this result
 101                 (a -> Bool)             -- Result within reasonable limits?
 102
 103 data PerModuleTableSpec =
 104         forall a . Result a =>
 105            SpecM
 106                 String                  -- Name of the table
 107                 String                  -- HTML tag for the table
 108                 (Results -> Map String a)       -- get the module map
 109                 (a -> Bool)             -- Result within reasonable limits?
 110
 111 -- The various per-program aspects of execution that we can generate results for.
 112 size_spec    = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
 113 alloc_spec   = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok
 114 runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok
 115 muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok
 116 gctime_spec  = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok
 117 gcwork_spec  = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok
 118 instrs_spec  = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
 119 mreads_spec  = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
 120 mwrite_spec  = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok
 121 cmiss_spec   = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok
 122
 123 all_specs = [
 124   size_spec,
 125   alloc_spec,
 126   runtime_spec,
 127   muttime_spec,
 128   gctime_spec,
 129   gcwork_spec,
 130   instrs_spec,
 131   mreads_spec,
 132   mwrite_spec,
 133   cmiss_spec
 134   ]
 135
 136 namedColumns :: [String] -> IO [PerProgTableSpec]
 137 namedColumns ss = mapM findSpec ss
 138   where findSpec s =
 139            case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
 140                          short_name == s ] of
 141                 [] -> die ("unknown column: " ++ s)
 142                 (spec:_) -> return spec
 143
 144 mean :: (Results -> [Float]) -> Results -> Maybe Float
 145 mean f results = go (f results)
 146   where go [] = Nothing
 147         go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs))
 148
 149 -- Look for bogus-looking times: On Linux we occasionally get timing results
 150 -- that are bizarrely low, and skew the average.
 151 checkTimes :: String -> Results -> IO ()
 152 checkTimes prog results = do
 153   check "run time" (run_time results)
 154   check "mut time" (mut_time results)
 155   check "GC time" (gc_time results)
 156   where
 157         check kind ts
 158            | any strange ts =
 159                 hPutStrLn stderr ("warning: dubious " ++ kind
 160                                    ++ " results for " ++ prog
 161                                    ++ ": " ++ show ts)
 162            | otherwise = return ()
 163            where strange t = any (\r -> time_ok r && r / t > 1.4) ts
 164                         -- looks for times that are >40% smaller than
 165                         -- any other.
 166
 167
 168 -- These are the per-prog tables we want to generate
 169 per_prog_result_tab =
 170         [ size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec,
 171           gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ]
 172
 173 -- A single summary table, giving comparison figures for a number of
 174 -- aspects, each in its own column.  Only works when comparing two runs.
 175 normal_summary_specs =
 176         [ size_spec, alloc_spec, runtime_spec ]
 177
 178 cachegrind_summary_specs =
 179         [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
 180
 181 -- Pick an appropriate summary table: if we're cachegrinding, then
 182 -- we're probably not interested in the runtime, but we are interested
 183 -- in instructions, mem reads and mem writes (and vice-versa).
 184 pickSummary :: [ResultTable] -> [PerProgTableSpec]
 185 pickSummary rs
 186   | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
 187   | otherwise = cachegrind_summary_specs
 188
 189 per_module_result_tab =
 190         [ SpecM "Module Sizes"  "mod-sizes"     module_size  always_ok
 191         , SpecM "Compile Times" "compile-time"  compile_time time_ok
 192         ]
 193
 194 always_ok :: a -> Bool
 195 always_ok = const True
 196
 197 time_ok :: Float -> Bool
 198 time_ok t = t > tooquick_threshold
 199
 200 -----------------------------------------------------------------------------
 201 -- HTML page generation
 202
 203 --htmlPage :: Results -> [String] -> Html
 204 htmlPage results args
 205    =  header << thetitle << reportTitle
 206           +++ hr
 207           +++ h1 << reportTitle
 208           +++ gen_menu
 209           +++ hr
 210           +++ body (gen_tables results args)
 211
 212 gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
 213                       ++ map (module_menu_item) per_module_result_tab)
 214
 215 prog_menu_item (SpecP name _ anc _ _ _) = anchor <! [href ('#':anc)] << name
 216 module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
 217
 218 gen_tables results args =
 219   foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
 220   +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
 221
 222 htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
 223   =   sectHeading title anc
 224   +++ font <! [size "1"]
 225         << mkTable (htmlShowResults results args get_result get_status result_ok)
 226   +++ hr
 227
 228 htmlGenModTable results args (SpecM title anc get_result result_ok)
 229   =   sectHeading title anc
 230   +++ font <![size "1"]
 231         << mkTable (htmlShowMultiResults results args get_result result_ok)
 232   +++ hr
 233
 234 sectHeading :: String -> String -> Html
 235 sectHeading s nm = h2 << anchor <! [name nm] << s
 236
 237 htmlShowResults
 238     :: Result a
 239         => [ResultTable]
 240         -> [String]
 241         -> (Results -> Maybe a)
 242         -> (Results -> Status)
 243         -> (a -> Bool)
 244         -> HtmlTable
 245
 246 htmlShowResults (r:rs) ss f stat result_ok
 247   =   tabHeader ss
 248   </> aboves (zipWith tableRow [1..] results_per_prog)
 249   </> aboves ((if nodevs then []
 250                          else [tableRow (-1) ("-1 s.d.", lows),
 251                                tableRow (-1) ("+1 s.d.", highs)])
 252                     ++ [tableRow (-1) ("Average", gms)])
 253  where
 254         -- results_per_prog :: [ (String,[BoxValue a]) ]
 255         results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
 256
 257         results_per_run  = transpose (map snd results_per_prog)
 258         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 259
 260 htmlShowMultiResults
 261     :: Result a
 262         => [ResultTable]
 263         -> [String]
 264         -> (Results -> Map String a)
 265         -> (a -> Bool)
 266         -> HtmlTable
 267
 268 htmlShowMultiResults (r:rs) ss f result_ok =
 269         multiTabHeader ss
 270          </> aboves (map show_results_for_prog results_per_prog_mod_run)
 271          </> aboves ((if nodevs then []
 272                                       else [td << bold << "-1 s.d."
 273                                             <-> tableRow (-1) ("", lows),
 274                                             td << bold << "+1 s.d."
 275                                             <-> tableRow (-1) ("", highs)])
 276                            ++ [td << bold << "Average"
 277                                <-> tableRow (-1) ("", gms)])
 278
 279   where
 280         base_results = Map.toList r :: [(String,Results)]
 281
 282         -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
 283         results_per_prog_mod_run = map get_results_for_prog base_results
 284
 285         -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
 286         get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r)))
 287
 288            where fms = map get_run_results rs
 289
 290                  get_run_results fm = case Map.lookup prog fm of
 291                                         Nothing  -> Map.empty
 292                                         Just res -> f res
 293
 294                  get_results_for_mod (id,attr) = calc_result fms Just (const Success)
 295                                                              result_ok (id,attr)
 296
 297         show_results_for_prog (prog,mrs) =
 298             td <! [valign "top"] << bold << prog
 299             <-> (if null mrs then
 300                    td << "(no modules compiled)"
 301                  else
 302                    toHtml (aboves (map (tableRow 0) mrs)))
 303
 304         results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
 305                                            (_,xs) <- mods]
 306         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 307
 308 tableRow :: Int -> (String, [BoxValue]) -> HtmlTable
 309 tableRow row_no (prog, results)
 310         =   td <! [bgcolor left_column_color] << prog
 311         <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
 312                                 results)
 313   where clr | row_no < 0  = bgcolor average_row_color
 314             | even row_no = bgcolor even_row_color
 315             | otherwise   = bgcolor odd_row_color
 316
 317 left_column_color = "#d0d0ff"  -- light blue
 318 odd_row_color     = "#d0d0ff"  -- light blue
 319 even_row_color    = "#f0f0ff"  -- v. light blue
 320 average_row_color = "#ffd0d0"  -- light red
 321
 322 {-
 323 findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
 324 findBest stuff@(Result base : rest)
 325   = map (\a -> (a==base, a))
 326   where
 327         best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
 328
 329         no_pcnt_stuff = map unPcnt stuff
 330
 331         unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
 332         unPcnt (r@(Result a) : rest)     = (a, r) : unPcnt rest
 333         unPcnt (_ : rest)                = unPcnt rest
 334 -}
 335
 336 logHeaders ss
 337   = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
 338
 339 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
 340
 341 tabHeader ss
 342   =   (td <! [align "left", width "100"] << bold << "Program")
 343   <-> logHeaders ss
 344
 345 multiTabHeader ss
 346   =   (td <! [align "left", width "100"] << bold << "Program")
 347   <-> (td <! [align "left", width "100"] << bold << "Module")
 348   <-> logHeaders ss
 349
 350 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
 351
 352 calcColor :: Int -> String
 353 calcColor p | p >= 0    = "#"     ++ (showHex red 2 "0000")
 354               | otherwise = "#0000" ++ (showHex blue 2 "")
 355         where red  = p * 255 `div` 100
 356               blue = (-p) * 255 `div` 100
 357
 358 showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s
 359 showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s)
 360
 361 hexDig i | i > 10 = chr (i-10 + ord 'a')
 362          | otherwise = chr (i + ord '0')
 363
 364 -----------------------------------------------------------------------------
 365 -- LaTeX table generation (just the summary for now)
 366
 367 latexOutput results args summary_spec summary_rows =
 368    (if (length results == 2)
 369         then ascii_summary_table True results summary_spec summary_rows
 370             . str "\n\n"
 371         else id) ""
 372
 373
 374 -----------------------------------------------------------------------------
 375 -- ASCII page generation
 376
 377 asciiPage results args summary_spec summary_rows =
 378   ( str reportTitle
 379   . str "\n\n"
 380      -- only show the summary table if we're comparing two runs
 381   . (if (length results == 2)
 382         then ascii_summary_table False results summary_spec summary_rows . str "\n\n"
 383         else id)
 384   . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
 385   . str "\n"
 386   . interleave "\n\n" (map (asciiGenModTable results args)  per_module_result_tab)
 387   ) "\n"
 388
 389 asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
 390   = str title
 391   . str "\n"
 392   . ascii_show_results results args get_result get_status result_ok
 393
 394 asciiGenModTable results args (SpecM title anc get_result result_ok)
 395   = str title
 396   . str "\n"
 397   . ascii_show_multi_results results args get_result result_ok
 398
 399 ascii_header width ss
 400         = str "\n-------------------------------------------------------------------------------\n"
 401         . str (rjustify 15 "Program")
 402         . str (space 5)
 403         . foldr (.) id (map (str . rjustify width) ss)
 404         . str "\n-------------------------------------------------------------------------------\n"
 405
 406 ascii_show_results
 407    :: Result a
 408         => [ResultTable]
 409         -> [String]
 410         -> (Results -> Maybe a)
 411         -> (Results -> Status)
 412         -> (a -> Bool)
 413         -> ShowS
 414
 415 ascii_show_results (r:rs) ss f stat result_ok
 416         = ascii_header fIELD_WIDTH ss
 417         . interleave "\n" (map show_per_prog_results results_per_prog)
 418         . if nodevs then id
 419                     else   str "\n"
 420                          . show_per_prog_results ("-1 s.d.",lows)
 421                          . str "\n"
 422                          . show_per_prog_results ("+1 s.d.",highs)
 423         . str "\n"
 424         . show_per_prog_results ("Average",gms)
 425  where
 426         -- results_per_prog :: [ (String,[BoxValue a]) ]
 427         results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
 428
 429         results_per_run  = transpose (map snd results_per_prog)
 430         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 431
 432 -- A summary table, useful only when we are comparing two runs.  This table
 433 -- shows a number of different result categories, one per column.
 434 ascii_summary_table
 435         :: Bool                         -- generate a LaTeX table?
 436         -> [ResultTable]
 437         -> [PerProgTableSpec]
 438         -> Maybe [String]
 439         -> ShowS
 440 ascii_summary_table latex (r1:r2:_) specs mb_restrict
 441   | latex     = makeLatexTable (rows ++ TableLine : av_rows)
 442   | otherwise =
 443        makeTable (table_layout (length specs) width)
 444           (TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows)
 445   where
 446         header = BoxString "Program" : map BoxString headings
 447
 448         (headings, columns, av_cols) = unzip3 (map calc_col specs)
 449         av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]
 450         baseline = Map.toList r1
 451         progs   = map BoxString (Map.keys r1)
 452         rows0   = map TableRow (zipWith (:) progs (transpose columns))
 453
 454         rows1 = restrictRows mb_restrict rows0
 455
 456         rows | latex     = mungeForLaTeX rows1
 457              | otherwise = rows1
 458
 459         av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
 460         width   = 10
 461
 462         calc_col (SpecP _ heading _ getr gets ok)
 463           = (heading, column, [min,max,mean]) -- throw away the baseline result
 464           where (_, boxes) = unzip (map calc_one_result baseline)
 465                 calc_one_result = calc_result [r2] getr gets ok
 466                 column = map (\(_:b:_) -> b) boxes
 467                 (_,mean,_) = calc_gmsd column
 468                 (min,max) = calc_minmax column
 469
 470 restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
 471 restrictRows Nothing rows = rows
 472 restrictRows (Just these) rows = filter keep_it rows
 473   where keep_it (TableRow (BoxString s: _)) = s `elem` these
 474         keep_it TableLine = True
 475         keep_it _ = False
 476
 477 mungeForLaTeX :: [TableRow] -> [TableRow]
 478 mungeForLaTeX = map transrow
 479    where
 480         transrow (TableRow boxes) = TableRow (map transbox boxes)
 481         transrow row = row
 482
 483         transbox (BoxString s) = BoxString (foldr transchar "" s)
 484         transbox box = box
 485
 486         transchar '_' s = '\\':'_':s
 487         transchar c s = c:s
 488
 489 table_layout n width =
 490   (str . rjustify 15) :
 491   (\s -> str (space 5) . str (rjustify width s)) :
 492   replicate (n-1) (str . rjustify width)
 493
 494 ascii_show_multi_results
 495    :: Result a
 496         => [ResultTable]
 497         -> [String]
 498         -> (Results -> Map String a)
 499         -> (a -> Bool)
 500         -> ShowS
 501
 502 ascii_show_multi_results (r:rs) ss f result_ok
 503         = ascii_header fIELD_WIDTH ss
 504         . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
 505         . str "\n"
 506         . if nodevs then id
 507                     else   str "\n"
 508                          . show_per_prog_results ("-1 s.d.",lows)
 509                          . str "\n"
 510                          . show_per_prog_results ("+1 s.d.",highs)
 511         . str "\n"
 512         . show_per_prog_results ("Average",gms)
 513   where
 514         base_results = Map.toList r :: [(String,Results)]
 515
 516         -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
 517         results_per_prog_mod_run = map get_results_for_prog base_results
 518
 519         -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
 520         get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r)))
 521
 522            where fms = map get_run_results rs
 523
 524                  get_run_results fm = case Map.lookup prog fm of
 525                                         Nothing  -> Map.empty
 526                                         Just res -> f res
 527
 528                  get_results_for_mod (id,attr) = calc_result fms Just (const Success)
 529                                                              result_ok (id,attr)
 530
 531         show_results_for_prog (prog,mrs) =
 532               str ("\n"++prog++"\n")
 533             . (if null mrs then
 534                    str "(no modules compiled)\n"
 535                  else
 536                    interleave "\n" (map show_per_prog_results mrs))
 537
 538         results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
 539                                            (_,xs) <- mods]
 540         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 541
 542
 543 show_per_prog_results :: (String, [BoxValue]) -> ShowS
 544 show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
 545
 546 show_per_prog_results_width width (prog,results)
 547         = str (rjustify 15 prog)
 548         . str (space 5)
 549         . foldr (.) id (map (str . rjustify width . showBox) results)
 550
 551 -- ---------------------------------------------------------------------------
 552 -- Generic stuff for results generation
 553
 554 -- calc_result is a nice exercise in higher-order programming...
 555 calc_result
 556   :: Result a
 557         => [Map String b]               -- accumulated results
 558         -> (b -> Maybe a)               -- get a result from the b
 559         -> (b -> Status)                -- get a status from the b
 560         -> (a -> Bool)                  -- is this result ok?
 561         -> (String,b)                   -- the baseline result
 562         -> (String,[BoxValue])
 563
 564 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
 565         (prog, (just_result baseline base_stat :
 566
 567           let
 568                 rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
 569
 570                 get_stuff Nothing  = (Nothing, NotDone)
 571                 get_stuff (Just r) = (get_maybe_a r, get_stat r)
 572           in
 573           (
 574           case baseline of
 575                 Just base | result_ok base
 576                    -> map (\(r,s) -> percentage  r s base) rts'
 577                 _other
 578                    -> map (\(r,s) -> just_result r s) rts'
 579            )))
 580  where
 581         baseline  = get_maybe_a base_r
 582         base_stat = get_stat base_r
 583
 584         just_result Nothing  s = RunFailed s
 585         just_result (Just a) s = toBox a
 586
 587         percentage Nothing   s base = RunFailed s
 588         percentage (Just a)  s base = Percentage
 589                                          (convert_to_percentage base a)
 590 -----------------------------------------------------------------------------
 591 -- Calculating geometric means and standard deviations
 592
 593 {-
 594 This is done using the log method, to avoid needing really large
 595 intermediate results.  The formula for a geometric mean is
 596
 597         (a1 * .... * an) ^ 1/n
 598
 599 which is equivalent to
 600
 601         e ^ ( (log a1 + ... + log an) / n )
 602
 603 where log is the natural logarithm function.
 604
 605 Similarly, to compute the geometric standard deviation we compute the
 606 deviation of each log, take the root-mean-square, and take the
 607 exponential again:
 608
 609         e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
 610
 611 where lbar is the mean log,
 612
 613         (log a1 + ... + log an) / n
 614
 615 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
 616 not subtract 100 from gm before performing this calculation.
 617
 618 We therefore return a (low, mean, high) triple.
 619
 620 -}
 621
 622 calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
 623 calc_gmsd xs
 624   | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
 625   | otherwise        = let sqr x = x * x
 626                            len   = fromIntegral (length percentages)
 627                            logs  = map log percentages
 628                            lbar  = sum logs / len
 629                            devs  = map (sqr . (lbar-)) logs
 630                            dbar  = sum devs / len
 631                            gm    = exp lbar
 632                            sdf   = exp (sqrt dbar)
 633                        in
 634                        (Percentage (gm/sdf),
 635                         Percentage gm,
 636                         Percentage (gm*sdf))
 637  where
 638   percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
 639         -- can't do log(0.0), so exclude zeros
 640         -- small values have inordinate effects so cap at -95%.
 641
 642 calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
 643 calc_minmax xs
 644  | null percentages = (RunFailed NotDone, RunFailed NotDone)
 645  | otherwise = (Percentage (minimum percentages),
 646                 Percentage (maximum percentages))
 647  where
 648   percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
 649
 650
 651 -----------------------------------------------------------------------------
 652 -- Show the Results
 653
 654 class Num a => Result a where
 655         toBox :: a -> BoxValue
 656         convert_to_percentage :: a -> a -> Float
 657
 658 -- We assume an Int is a size, and print it in kilobytes.
 659
 660 instance Result Int where
 661         convert_to_percentage 0 size = 100
 662         convert_to_percentage base size = (fromIntegral size / fromIntegral base) * 100
 663
 664         toBox = BoxInt
 665
 666 instance Result Integer where
 667         convert_to_percentage 0 size = 100
 668         convert_to_percentage base size = (fromInteger size / fromInteger base) * 100
 669         toBox = BoxInteger
 670
 671
 672 instance Result Float where
 673         convert_to_percentage 0.0 size = 100.0
 674         convert_to_percentage base size = size / base * 100
 675
 676         toBox = BoxFloat
 677
 678 -- -----------------------------------------------------------------------------
 679 -- BoxValues
 680
 681 -- The contents of a box in a table
 682 data BoxValue
 683   = RunFailed Status
 684   | Percentage Float
 685   | BoxFloat Float
 686   | BoxInt Int
 687   | BoxInteger Integer
 688   | BoxString String
 689
 690 showBox :: BoxValue -> String
 691 showBox (RunFailed stat) = show_stat stat
 692 showBox (Percentage f)   = show_pcntage f
 693 showBox (BoxFloat f)     = printf "%.2f" f
 694 showBox (BoxInt n)       = show (n `div` 1024) ++ "k"
 695 showBox (BoxInteger n)   = show (n `div` 1024) ++ "k"
 696 showBox (BoxString s)    = s
 697
 698 instance Show BoxValue where { show = showBox }
 699
 700 show_pcntage n = show_float_signed (n-100) ++ "%"
 701
 702 show_float_signed n
 703   | n >= 0    = printf "+%.1f" n
 704   | otherwise = printf "%.1f" n
 705
 706 show_stat Success     = "(no result)"
 707 show_stat WrongStdout = "(stdout)"
 708 show_stat WrongStderr = "(stderr)"
 709 show_stat (Exit x)    = "exit(" ++ show x ++")"
 710 show_stat OutOfHeap   = "(heap)"
 711 show_stat OutOfStack  = "(stack)"
 712 show_stat NotDone     = "-----"
 713
 714 -- -----------------------------------------------------------------------------
 715 -- Table layout
 716
 717 data TableRow
 718   = TableRow [BoxValue]
 719   | TableLine
 720
 721 type Layout = [String -> ShowS]
 722
 723 makeTable :: Layout -> [TableRow] -> ShowS
 724 makeTable p = interleave "\n" . map do_row
 725   where do_row (TableRow boxes) = applyLayout p boxes
 726         do_row TableLine = str (take 80 (repeat '-'))
 727
 728 makeLatexTable :: [TableRow] -> ShowS
 729 makeLatexTable = foldr (.) id . map do_row
 730   where do_row (TableRow boxes)
 731            = applyLayout latexTableLayout boxes . str "\\\\\n"
 732         do_row TableLine
 733            = str "\\hline\n"
 734
 735 latexTableLayout :: Layout
 736 latexTableLayout = box : repeat (box . (" & "++))
 737   where box s = str (foldr transchar "" s)
 738
 739         transchar '%' s = s  -- leave out the percentage signs
 740         transchar c   s = c : s
 741
 742 applyLayout :: Layout -> [BoxValue] -> ShowS
 743 applyLayout layout values =
 744  foldr (.) id [ f (show val) | (val,f) <- zip values layout ]
 745
 746 -- -----------------------------------------------------------------------------
 747 -- General Utils
 748
 749 split :: Char -> String -> [String]
 750 split c s = case rest of
 751                 []     -> [chunk]
 752                 _:rest -> chunk : split c rest
 753   where (chunk, rest) = break (==c) s
 754
 755 str = showString
 756
 757 interleave s = foldr1 (\a b -> a . str s . b)
 758
 759 fIELD_WIDTH = 16 :: Int
 760
 761 -----------------------------------------------------------------------------