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