glafp-utils/nofib-analyse/Main.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: Main.hs,v 1.3 2000/03/02 11:39:45 keithw 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 DataHtml
  13 import CmdLine
  14
  15 import GlaExts
  16 import FiniteMap
  17 import GetOpt
  18
  19 import Char
  20 import IO
  21 import Array
  22 import System
  23 import List
  24
  25 -----------------------------------------------------------------------------
  26 -- Top level stuff
  27
  28 die :: String -> IO a
  29 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
  30
  31 usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
  32
  33 main = do
  34
  35  if not (null cmdline_errors) || OptHelp `elem` flags
  36         then die (concat cmdline_errors ++ usageInfo usageHeader argInfo)
  37         else do
  38
  39  let { html  = OptHTMLOutput  `elem` flags;
  40        ascii = OptASCIIOutput `elem` flags
  41      }
  42
  43  if ascii && html
  44         then die "Can't produce both ASCII and HTML"
  45         else do
  46
  47  if devs && nodevs
  48         then die "Can't both display and hide deviations"
  49         else do
  50
  51  results <- parse_logs other_args
  52
  53  let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
  54
  55  if html
  56         then putStr (renderHtml (htmlPage results column_headings))
  57         else putStr (asciiPage results column_headings)
  58
  59
  60 parse_logs :: [String] -> IO [ResultTable]
  61 parse_logs [] = do
  62         f <- hGetContents stdin
  63         return [parse_log f]
  64 parse_logs log_files =
  65         mapM (\f -> do h <- openFile f ReadMode
  66                        c <- hGetContents h
  67                        return (parse_log c)) log_files
  68
  69 -----------------------------------------------------------------------------
  70 -- List of tables we're going to generate
  71
  72 data PerProgTableSpec =
  73         forall a . Result a =>
  74            SpecP
  75                 String                  -- Name of the table
  76                 String                  -- HTML tag for the table
  77                 (Results -> Maybe a)    -- How to get the result
  78                 (Results -> Status)     -- How to get the status of this result
  79                 (a -> Bool)             -- Result within reasonable limits?
  80
  81 data PerModuleTableSpec =
  82         forall a . Result a =>
  83            SpecM
  84                 String                  -- Name of the table
  85                 String                  -- HTML tag for the table
  86                 (Results -> FiniteMap String a) -- get the module map
  87                 (a -> Bool)             -- Result within reasonable limits?
  88
  89 per_prog_result_tab =
  90         [ SpecP "Binary Sizes" "binary-sizes" binary_size compile_status always_ok
  91         , SpecP "Allocations" "allocations" allocs run_status always_ok
  92         , SpecP "Run Time" "run-times" run_time run_status time_ok
  93         , SpecP "Mutator Time" "mutator-time" mut_time run_status time_ok
  94         , SpecP "GC Time" "gc-time" gc_time run_status time_ok
  95         , SpecP "GC Work" "gc-work" gc_work run_status always_ok
  96         , SpecP "Instructions" "instrs" instrs run_status always_ok
  97         , SpecP "Memory Reads" "mem-reads" mem_reads run_status always_ok
  98         , SpecP "Memory Writes" "mem-writes" mem_writes run_status always_ok
  99         ]
 100
 101 per_module_result_tab =
 102         [ SpecM "Module Sizes"  "mod-sizes"     module_size  always_ok
 103         , SpecM "Compile Times" "compile-time"  compile_time time_ok
 104         ]
 105
 106 always_ok :: a -> Bool
 107 always_ok = const True
 108
 109 time_ok :: Float -> Bool
 110 time_ok t = t > tooquick_threshold
 111
 112 -----------------------------------------------------------------------------
 113 -- HTML page generation
 114
 115 htmlPage results args
 116    =  header [] (theTitle [] (htmlStr "NoFib Results"))
 117           +++ bar []
 118           +++ gen_menu
 119           +++ bar []
 120           +++ body [] (gen_tables results args)
 121
 122 gen_menu = ul [] (foldr1 (+++) (map (li [] +++)
 123         (map (prog_menu_item)   per_prog_result_tab
 124       ++ map (module_menu_item) per_module_result_tab)))
 125
 126 prog_menu_item (SpecP name anc _ _ _) = anchor [href ('#':anc)] (htmlStr name)
 127 module_menu_item (SpecM name anc _ _) = anchor [href ('#':anc)] (htmlStr name)
 128
 129 gen_tables results args =
 130   foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
 131   +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
 132
 133 htmlGenProgTable results args (SpecP title anc get_result get_status result_ok)
 134   =   sectHeading title anc
 135   +++ font [size 1] (
 136          mkTable (htmlShowResults results args get_result get_status result_ok))
 137   +++ bar []
 138
 139 htmlGenModTable results args (SpecM title anc get_result result_ok)
 140   =   sectHeading title anc
 141   +++ font [size 1] (
 142          mkTable (htmlShowMultiResults results args get_result result_ok))
 143   +++ bar []
 144
 145 sectHeading :: String -> String -> Html
 146 sectHeading s nm
 147         = h2 [] (anchor [name nm] (htmlStr s))
 148
 149 htmlShowResults
 150     :: Result a
 151         => [ResultTable]
 152         -> [String]
 153         -> (Results -> Maybe a)
 154         -> (Results -> Status)
 155         -> (a -> Bool)
 156         -> HtmlTable
 157
 158 htmlShowResults (r:rs) ss f stat result_ok
 159   =   tabHeader ss
 160   +/+ foldr1 (+/+) (zipWith tableRow [1..] results_per_prog)
 161   +/+ foldr1 (+/+) ((if nodevs then []
 162                                else [tableRow (-1) ("-1 s.d.", lows),
 163                                      tableRow (-1) ("+1 s.d.", highs)])
 164                     ++ [tableRow (-1) ("Average", gms)])
 165  where
 166         -- results_per_prog :: [ (String,[BoxValue a]) ]
 167         results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
 168
 169         results_per_run  = transpose (map snd results_per_prog)
 170         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 171
 172 htmlShowMultiResults
 173     :: Result a
 174         => [ResultTable]
 175         -> [String]
 176         -> (Results -> FiniteMap String a)
 177         -> (a -> Bool)
 178         -> HtmlTable
 179
 180 htmlShowMultiResults (r:rs) ss f result_ok =
 181         multiTabHeader ss
 182          +/+ foldr1 (+/+) (map show_results_for_prog results_per_prog_mod_run)
 183          +/+ foldr1 (+/+) ((if nodevs then []
 184                                       else [(cellHtml [] (bold [] (htmlStr "-1 s.d.")))
 185                                             +-+ tableRow (-1) ("", lows),
 186                                             (cellHtml [] (bold [] (htmlStr "+1 s.d.")))
 187                                             +-+ tableRow (-1) ("", highs)])
 188                            ++ [cellHtml [] (bold [] (htmlStr "Average"))
 189                                +-+ tableRow (-1) ("", gms)])
 190
 191   where
 192         base_results = fmToList r :: [(String,Results)]
 193
 194         -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
 195         results_per_prog_mod_run = map get_results_for_prog base_results
 196
 197         -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
 198         get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
 199
 200            where fms = map get_run_results rs
 201
 202                  get_run_results fm = case lookupFM fm prog of
 203                                         Nothing  -> emptyFM
 204                                         Just res -> f res
 205
 206                  get_results_for_mod (id,attr) = calc_result fms Just (const Success)
 207                                                              result_ok (id,attr)
 208
 209         show_results_for_prog (prog,mrs) =
 210             cellHtml [valign "top"] (bold [] (htmlStr prog))
 211             +-+ (if null mrs then
 212                    cellHtml [] (htmlStr "(no modules compiled)")
 213                  else
 214                    foldr1 (+/+) (map (tableRow 0) mrs))
 215
 216         results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
 217                                            (_,xs) <- mods]
 218         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 219
 220 tableRow :: Result a => Int -> (String, [BoxValue a]) -> HtmlTable
 221 tableRow row_no (prog, results)
 222         =   cellHtml [bgcolor left_column_color] (htmlStr prog)
 223         +-+ foldr1 (+-+) (map (cellHtml [align "right", clr]
 224                                . htmlStr . show_box) results)
 225   where clr | row_no < 0  = bgcolor average_row_color
 226             | even row_no = bgcolor even_row_color
 227             | otherwise   = bgcolor odd_row_color
 228
 229 left_column_color = "#d0d0ff"  -- light blue
 230 odd_row_color     = "#d0d0ff"  -- light blue
 231 even_row_color    = "#f0f0ff"  -- v. light blue
 232 average_row_color = "#ffd0d0"  -- light red
 233
 234 {-
 235 findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
 236 findBest stuff@(Result base : rest)
 237   = map (\a -> (a==base, a))
 238   where
 239         best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
 240
 241         no_pcnt_stuff = map unPcnt stuff
 242
 243         unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
 244         unPcnt (r@(Result a) : rest)     = (a, r) : unPcnt rest
 245         unPcnt (_ : rest)                = unPcnt rest
 246 -}
 247
 248 logHeaders ss
 249   = foldr1 (+-+) (map (\s -> cellHtml [align "right", width "100"]
 250         (bold [] (htmlStr s))) ss)
 251
 252 mkTable :: HtmlTable -> Html
 253 mkTable = renderTable [cellspacing 0, cellpadding 0, border 0]
 254
 255 tabHeader ss
 256   =   cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
 257   +-+ logHeaders ss
 258
 259 multiTabHeader ss
 260   =   cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
 261   +-+ cellHtml [align "left", width "100"] (bold [] (htmlStr "Module"))
 262   +-+ logHeaders ss
 263
 264 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
 265
 266 calcColor :: Int -> String
 267 calcColor p | p >= 0    = "#"     ++ (showHex red 2 "0000")
 268               | otherwise = "#0000" ++ (showHex blue 2 "")
 269         where red  = p * 255 `div` 100
 270               blue = (-p) * 255 `div` 100
 271
 272 showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s
 273 showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s)
 274
 275 hexDig i | i > 10 = chr (i-10 + ord 'a')
 276          | otherwise = chr (i + ord '0')
 277
 278 -----------------------------------------------------------------------------
 279 -- ASCII page generation
 280
 281 asciiPage results args =
 282   ( interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
 283   . str "\n"
 284   . interleave "\n\n" (map (asciiGenModTable results args)  per_module_result_tab)
 285   ) "\n"
 286
 287 asciiGenProgTable results args (SpecP title anc get_result get_status result_ok)
 288   = str title
 289   . str "\n"
 290   . ascii_show_results results args get_result get_status result_ok
 291
 292 asciiGenModTable results args (SpecM title anc get_result result_ok)
 293   = str title
 294   . str "\n"
 295   . ascii_show_multi_results results args get_result result_ok
 296
 297 ascii_header ss
 298         = str "\n-------------------------------------------------------------------------------\n"
 299         . str (rjustify 15 "Program")
 300         . str (space 5)
 301         . foldr (.) id (map (str . rjustify fIELD_WIDTH) ss)
 302         . str "\n-------------------------------------------------------------------------------\n"
 303
 304 ascii_show_results
 305    :: Result a
 306         => [ResultTable]
 307         -> [String]
 308         -> (Results -> Maybe a)
 309         -> (Results -> Status)
 310         -> (a -> Bool)
 311         -> ShowS
 312
 313 ascii_show_results (r:rs) ss f stat result_ok
 314         = ascii_header ss
 315         . interleave "\n" (map show_per_prog_results results_per_prog)
 316         . if nodevs then id
 317                     else   str "\n"
 318                          . show_per_prog_results ("-1 s.d.",lows)
 319                          . str "\n"
 320                          . show_per_prog_results ("+1 s.d.",highs)
 321         . str "\n"
 322         . show_per_prog_results ("Average",gms)
 323  where
 324         -- results_per_prog :: [ (String,[BoxValue a]) ]
 325         results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
 326
 327         results_per_run  = transpose (map snd results_per_prog)
 328         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 329
 330 ascii_show_multi_results
 331    :: Result a
 332         => [ResultTable]
 333         -> [String]
 334         -> (Results -> FiniteMap String a)
 335         -> (a -> Bool)
 336         -> ShowS
 337
 338 ascii_show_multi_results (r:rs) ss f result_ok
 339         = ascii_header ss
 340         . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
 341         . str "\n"
 342         . if nodevs then id
 343                     else   str "\n"
 344                          . show_per_prog_results ("-1 s.d.",lows)
 345                          . str "\n"
 346                          . show_per_prog_results ("+1 s.d.",highs)
 347         . str "\n"
 348         . show_per_prog_results ("Average",gms)
 349   where
 350         base_results = fmToList r :: [(String,Results)]
 351
 352         -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
 353         results_per_prog_mod_run = map get_results_for_prog base_results
 354
 355         -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
 356         get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
 357
 358            where fms = map get_run_results rs
 359
 360                  get_run_results fm = case lookupFM fm prog of
 361                                         Nothing  -> emptyFM
 362                                         Just res -> f res
 363
 364                  get_results_for_mod (id,attr) = calc_result fms Just (const Success)
 365                                                              result_ok (id,attr)
 366
 367         show_results_for_prog (prog,mrs) =
 368               str ("\n"++prog++"\n")
 369             . (if null mrs then
 370                    str "(no modules compiled)\n"
 371                  else
 372                    interleave "\n" (map show_per_prog_results mrs))
 373
 374         results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
 375                                            (_,xs) <- mods]
 376         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 377
 378 show_per_prog_results :: Result a => (String, [BoxValue a]) -> ShowS
 379 show_per_prog_results (prog,results)
 380         = str (rjustify 15 prog)
 381         . str (space 5)
 382         . foldr (.) id (map (str . rjustify fIELD_WIDTH . show_box) results)
 383
 384 -----------------------------------------------------------------------------
 385 -- Show the Results
 386
 387 class Num a => Result a where
 388         result_to_string :: a -> String
 389         convert_to_percentage :: a -> a -> Float
 390
 391 -- We assume an Int is a size, and print it in kilobytes.
 392
 393 instance Result Int where
 394         convert_to_percentage 0 size = 100
 395         convert_to_percentage base size = (fromInt size / fromInt base) * 100
 396
 397         result_to_string n = show (n `div` 1024) ++ "k"
 398
 399 instance Result Integer where
 400         convert_to_percentage 0 size = 100
 401         convert_to_percentage base size = (fromInteger size / fromInteger base) * 100
 402
 403         result_to_string n = show (n `quot` 1024) ++ "k"
 404
 405 instance Result Float where
 406         convert_to_percentage 0.0 size = 100.0
 407         convert_to_percentage base size = size / base * 100
 408
 409         result_to_string = showFloat' Nothing (Just 2)
 410
 411 data BoxValue a = RunFailed Status | Percentage Float | Result a
 412
 413 -- calc_result is a nice exercise in higher-order programming...
 414 calc_result
 415   :: Result a
 416         => [FiniteMap String b]         -- accumulated results
 417         -> (b -> Maybe a)               -- get a result from the b
 418         -> (b -> Status)                -- get a status from the b
 419         -> (a -> Bool)                  -- is this result ok?
 420         -> (String,b)                   -- the baseline result
 421         -> (String,[BoxValue a])
 422
 423 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
 424         (prog, (just_result baseline base_stat :
 425
 426           let
 427                 rts' = map (\rt -> get_stuff (lookupFM rt prog)) rts
 428
 429                 get_stuff Nothing  = (Nothing, NotDone)
 430                 get_stuff (Just r) = (get_maybe_a r, get_stat r)
 431           in
 432           (
 433           case baseline of
 434                 Just base | result_ok base
 435                    -> map (\(r,s) -> percentage  r s base) rts'
 436                 _other
 437                    -> map (\(r,s) -> just_result r s) rts'
 438            )))
 439  where
 440         baseline  = get_maybe_a base_r
 441         base_stat = get_stat base_r
 442
 443         just_result Nothing  s = RunFailed s
 444         just_result (Just a) s = Result a
 445
 446         percentage Nothing   s base = RunFailed s
 447         percentage (Just a)  s base = Percentage
 448                                          (convert_to_percentage base a)
 449 show_box (RunFailed s)  = show_stat s
 450 show_box (Percentage p) = show_pcntage p
 451 show_box (Result a)     = result_to_string a
 452
 453 -----------------------------------------------------------------------------
 454 -- Calculating geometric means and standard deviations
 455
 456 {-
 457 This is done using the log method, to avoid needing really large
 458 intermediate results.  The formula for a geometric mean is
 459
 460         (a1 * .... * an) ^ 1/n
 461
 462 which is equivalent to
 463
 464         e ^ ( (log a1 + ... + log an) / n )
 465
 466 where log is the natural logarithm function.
 467
 468 Similarly, to compute the geometric standard deviation we compute the
 469 deviation of each log, take the root-mean-square, and take the
 470 exponential again:
 471
 472         e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
 473
 474 where lbar is the mean log,
 475
 476         (log a1 + ... + log an) / n
 477
 478 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
 479 not subtract 100 from gm before performing this calculation.
 480
 481 We therefore return a (low, mean, high) triple.
 482
 483 -}
 484
 485 calc_gmsd :: [BoxValue a] -> (BoxValue Float, BoxValue Float, BoxValue Float)
 486 calc_gmsd xs
 487   | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
 488   | otherwise        = let sqr x = x * x
 489                            len   = fromInt (length percentages)
 490                            logs  = map log percentages
 491                            lbar  = sum logs / len
 492                            devs  = map (sqr . (lbar-)) logs
 493                            dbar  = sum devs / len
 494                            gm    = exp lbar
 495                            sdf   = exp (sqrt dbar)
 496                        in
 497                        (Percentage (gm/sdf),
 498                         Percentage gm,
 499                         Percentage (gm*sdf))
 500  where
 501   percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
 502         -- can't do log(0.0), so exclude zeros
 503         -- small values have inordinate effects so cap at -95%.
 504
 505 -----------------------------------------------------------------------------
 506 -- Generic stuff for results generation
 507
 508 show_pcntage n = show_float_signed (n-100) ++ "%"
 509
 510 show_float_signed = showFloat False False True False False Nothing (Just 2)
 511
 512 show_stat Success     = "(no result)"
 513 show_stat WrongStdout = "(stdout)"
 514 show_stat WrongStderr = "(stderr)"
 515 show_stat (Exit x)    = "exit(" ++ show x ++")"
 516 show_stat OutOfHeap   = "(heap)"
 517 show_stat OutOfStack  = "(stack)"
 518 show_stat NotDone     = "-----"
 519
 520 str = showString
 521
 522 interleave s = foldr1 (\a b -> a . str s . b)
 523
 524 fIELD_WIDTH = 16 :: Int
 525
 526 -----------------------------------------------------------------------------