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.Exit      ( exitWith, ExitCode(..) )
  19
  20 import Control.Monad
  21 import Data.Maybe       ( isNothing )
  22 import Data.Char
  23 import System.IO
  24 import Data.List
  25
  26 (<!) = (Html.!)
  27
  28 -----------------------------------------------------------------------------
  29 -- Top level stuff
  30
  31 die :: String -> IO a
  32 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
  33
  34 main :: IO ()
  35 main = do
  36
  37  when (not (null cmdline_errors) || OptHelp `elem` flags) $
  38       die (concat cmdline_errors ++ usage)
  39
  40  let { html  = OptHTMLOutput  `elem` flags;
  41        latex = OptLaTeXOutput `elem` flags;
  42        ascii = OptASCIIOutput `elem` flags
  43      }
  44
  45  when (ascii && html)  $ die "Can't produce both ASCII and HTML"
  46  when (devs && nodevs) $ die "Can't both display and hide deviations"
  47
  48  results <- parse_logs other_args
  49
  50  summary_spec <- case [ cols | OptColumns cols <- flags ] of
  51                         []       -> return (pickSummary results)
  52                         (cols:_) -> namedColumns (split ',' cols)
  53
  54  let summary_rows = case [ rows | OptRows rows <- flags ] of
  55                         [] -> Nothing
  56                         rows -> Just (split ',' (last rows))
  57
  58  let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
  59
  60  -- sanity check
  61  sequence_ [ checkTimes prog res | result_table <- results,
  62                                    (prog,res) <- Map.toList result_table ]
  63
  64  case () of
  65    _ | html      ->
  66         putStr (renderHtml (htmlPage results column_headings))
  67    _ | latex     ->
  68         putStr (latexOutput results column_headings summary_spec summary_rows)
  69    _ | otherwise ->
  70         putStr (asciiPage results column_headings summary_spec summary_rows)
  71
  72
  73 parse_logs :: [String] -> IO [ResultTable]
  74 parse_logs [] = do
  75         f <- hGetContents stdin
  76         return [parse_log f]
  77 parse_logs log_files =
  78         mapM (\f -> do h <- openFile f ReadMode
  79                        c <- hGetContents h
  80                        return (parse_log c)) log_files
  81
  82 -----------------------------------------------------------------------------
  83 -- List of tables we're going to generate
  84
  85 data PerProgTableSpec =
  86         forall a . Result a =>
  87            SpecP
  88                 String                  -- Name of the table
  89                 String                  -- Short name (for column heading)
  90                 String                  -- HTML tag for the table
  91                 (Results -> Maybe a)    -- How to get the result
  92                 (Results -> Status)     -- How to get the status of this result
  93                 (a -> Bool)             -- Result within reasonable limits?
  94
  95 data PerModuleTableSpec =
  96         forall a . Result a =>
  97            SpecM
  98                 String                  -- Name of the table
  99                 String                  -- HTML tag for the table
 100                 (Results -> Map String a)       -- get the module map
 101                 (a -> Bool)             -- Result within reasonable limits?
 102
 103 -- The various per-program aspects of execution that we can generate results for.
 104 size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec,
 105     gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec
 106         :: PerProgTableSpec
 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
 117
 118 all_specs :: [PerProgTableSpec]
 119 all_specs = [
 120   size_spec,
 121   alloc_spec,
 122   runtime_spec,
 123   muttime_spec,
 124   gctime_spec,
 125   gcwork_spec,
 126   instrs_spec,
 127   mreads_spec,
 128   mwrite_spec,
 129   cmiss_spec
 130   ]
 131
 132 namedColumns :: [String] -> IO [PerProgTableSpec]
 133 namedColumns ss = mapM findSpec ss
 134   where findSpec s =
 135            case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
 136                          short_name == s ] of
 137                 [] -> die ("unknown column: " ++ s)
 138                 (spec:_) -> return spec
 139
 140 mean :: (Results -> [Float]) -> Results -> Maybe Float
 141 mean f results = go (f results)
 142   where go [] = Nothing
 143         go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs))
 144
 145 -- Look for bogus-looking times: On Linux we occasionally get timing results
 146 -- that are bizarrely low, and skew the average.
 147 checkTimes :: String -> Results -> IO ()
 148 checkTimes prog results = do
 149   check "run time" (run_time results)
 150   check "mut time" (mut_time results)
 151   check "GC time" (gc_time results)
 152   where
 153         check kind ts
 154            | any strange ts =
 155                 hPutStrLn stderr ("warning: dubious " ++ kind
 156                                    ++ " results for " ++ prog
 157                                    ++ ": " ++ show ts)
 158            | otherwise = return ()
 159            where strange t = any (\r -> time_ok r && r / t > 1.4) ts
 160                         -- looks for times that are >40% smaller than
 161                         -- any other.
 162
 163
 164 -- These are the per-prog tables we want to generate
 165 per_prog_result_tab :: [PerProgTableSpec]
 166 per_prog_result_tab =
 167         [ size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec,
 168           gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ]
 169
 170 -- A single summary table, giving comparison figures for a number of
 171 -- aspects, each in its own column.  Only works when comparing two runs.
 172 normal_summary_specs :: [PerProgTableSpec]
 173 normal_summary_specs =
 174         [ size_spec, alloc_spec, runtime_spec ]
 175
 176 cachegrind_summary_specs :: [PerProgTableSpec]
 177 cachegrind_summary_specs =
 178         [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
 179
 180 -- Pick an appropriate summary table: if we're cachegrinding, then
 181 -- we're probably not interested in the runtime, but we are interested
 182 -- in instructions, mem reads and mem writes (and vice-versa).
 183 pickSummary :: [ResultTable] -> [PerProgTableSpec]
 184 pickSummary rs
 185   | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
 186   | otherwise = cachegrind_summary_specs
 187
 188 per_module_result_tab :: [PerModuleTableSpec]
 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 :: [ResultTable] -> [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 :: [String] -> HtmlTable
 337 logHeaders ss
 338   = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
 339
 340 mkTable :: HtmlTable -> Html
 341 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
 342
 343 tabHeader :: [String] -> HtmlTable
 344 tabHeader ss
 345   =   (td <! [align "left", width "100"] << bold << "Program")
 346   <-> logHeaders ss
 347
 348 multiTabHeader :: [String] -> HtmlTable
 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) _ = toBox a
 590
 591         percentage Nothing   s _    = RunFailed s
 592         percentage (Just a)  _ 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    _    = 100
 666     convert_to_percentage base size
 667         = (fromIntegral size / fromIntegral base) * 100
 668
 669     toBox = BoxInt
 670
 671 instance Result Integer where
 672     convert_to_percentage 0    _    = 100
 673     convert_to_percentage base size
 674         = (fromInteger size / fromInteger base) * 100
 675     toBox = BoxInteger
 676
 677 instance Result Float where
 678     convert_to_percentage 0.0  _    = 100.0
 679     convert_to_percentage base size = size / base * 100
 680
 681     toBox = BoxFloat
 682
 683 -- -----------------------------------------------------------------------------
 684 -- BoxValues
 685
 686 -- The contents of a box in a table
 687 data BoxValue
 688   = RunFailed Status
 689   | Percentage Float
 690   | BoxFloat Float
 691   | BoxInt Int
 692   | BoxInteger Integer
 693   | BoxString String
 694
 695 showBox :: BoxValue -> String
 696 showBox (RunFailed stat) = show_stat stat
 697 showBox (Percentage f)   = printf "%+.1f%%" (f-100)
 698 showBox (BoxFloat f)     = printf "%.2f" f
 699 showBox (BoxInt n)       = show (n `div` 1024) ++ "k"
 700 showBox (BoxInteger n)   = show (n `div` 1024) ++ "k"
 701 showBox (BoxString s)    = s
 702
 703 instance Show BoxValue where
 704     show = showBox
 705
 706 show_stat :: Status -> String
 707 show_stat Success     = "(no result)"
 708 show_stat WrongStdout = "(stdout)"
 709 show_stat WrongStderr = "(stderr)"
 710 show_stat (Exit x)    = "exit(" ++ show x ++")"
 711 show_stat OutOfHeap   = "(heap)"
 712 show_stat OutOfStack  = "(stack)"
 713 show_stat NotDone     = "-----"
 714
 715 -- -----------------------------------------------------------------------------
 716 -- Table layout
 717
 718 data TableRow
 719   = TableRow [BoxValue]
 720   | TableLine
 721
 722 type Layout = [String -> ShowS]
 723
 724 makeTable :: Layout -> [TableRow] -> ShowS
 725 makeTable p = interleave "\n" . map do_row
 726   where do_row (TableRow boxes) = applyLayout p boxes
 727         do_row TableLine = str (take 80 (repeat '-'))
 728
 729 makeLatexTable :: [TableRow] -> ShowS
 730 makeLatexTable = foldr (.) id . map do_row
 731   where do_row (TableRow boxes)
 732            = applyLayout latexTableLayout boxes . str "\\\\\n"
 733         do_row TableLine
 734            = str "\\hline\n"
 735
 736 latexTableLayout :: Layout
 737 latexTableLayout = box : repeat (box . (" & "++))
 738   where box s = str (foldr transchar "" s)
 739
 740         transchar '%' s = s  -- leave out the percentage signs
 741         transchar c   s = c : s
 742
 743 applyLayout :: Layout -> [BoxValue] -> ShowS
 744 applyLayout layout values =
 745  foldr (.) id [ f (show val) | (val,f) <- zip values layout ]
 746
 747 -- -----------------------------------------------------------------------------
 748 -- General Utils
 749
 750 split :: Char -> String -> [String]
 751 split c s = case rest of
 752                 []     -> [chunk]
 753                 _:rest -> chunk : split c rest
 754   where (chunk, rest) = break (==c) s
 755
 756 str = showString
 757
 758 interleave s = foldr1 (\a b -> a . str s . b)
 759
 760 fIELD_WIDTH = 16 :: Int
 761
 762 -----------------------------------------------------------------------------