glafp-utils/nofib-analyse/Main.hs

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