glafp-utils/nofib-analyse/Main.hs

   1 -----------------------------------------------------------------------------
   2 -- $Id: Main.hs,v 1.4 2000/07/05 15:42:19 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 reportTitle))
 117           +++ bar []
 118           +++ h1 [] (htmlStr reportTitle)
 119           +++ gen_menu
 120           +++ bar []
 121           +++ body [] (gen_tables results args)
 122
 123 gen_menu = ul [] (foldr1 (+++) (map (li [] +++)
 124         (map (prog_menu_item)   per_prog_result_tab
 125       ++ map (module_menu_item) per_module_result_tab)))
 126
 127 prog_menu_item (SpecP name anc _ _ _) = anchor [href ('#':anc)] (htmlStr name)
 128 module_menu_item (SpecM name anc _ _) = anchor [href ('#':anc)] (htmlStr name)
 129
 130 gen_tables results args =
 131   foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab)
 132   +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab)
 133
 134 htmlGenProgTable results args (SpecP title anc get_result get_status result_ok)
 135   =   sectHeading title anc
 136   +++ font [size 1] (
 137          mkTable (htmlShowResults results args get_result get_status result_ok))
 138   +++ bar []
 139
 140 htmlGenModTable results args (SpecM title anc get_result result_ok)
 141   =   sectHeading title anc
 142   +++ font [size 1] (
 143          mkTable (htmlShowMultiResults results args get_result result_ok))
 144   +++ bar []
 145
 146 sectHeading :: String -> String -> Html
 147 sectHeading s nm
 148         = h2 [] (anchor [name nm] (htmlStr s))
 149
 150 htmlShowResults
 151     :: Result a
 152         => [ResultTable]
 153         -> [String]
 154         -> (Results -> Maybe a)
 155         -> (Results -> Status)
 156         -> (a -> Bool)
 157         -> HtmlTable
 158
 159 htmlShowResults (r:rs) ss f stat result_ok
 160   =   tabHeader ss
 161   +/+ foldr1 (+/+) (zipWith tableRow [1..] results_per_prog)
 162   +/+ foldr1 (+/+) ((if nodevs then []
 163                                else [tableRow (-1) ("-1 s.d.", lows),
 164                                      tableRow (-1) ("+1 s.d.", highs)])
 165                     ++ [tableRow (-1) ("Average", gms)])
 166  where
 167         -- results_per_prog :: [ (String,[BoxValue a]) ]
 168         results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
 169
 170         results_per_run  = transpose (map snd results_per_prog)
 171         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 172
 173 htmlShowMultiResults
 174     :: Result a
 175         => [ResultTable]
 176         -> [String]
 177         -> (Results -> FiniteMap String a)
 178         -> (a -> Bool)
 179         -> HtmlTable
 180
 181 htmlShowMultiResults (r:rs) ss f result_ok =
 182         multiTabHeader ss
 183          +/+ foldr1 (+/+) (map show_results_for_prog results_per_prog_mod_run)
 184          +/+ foldr1 (+/+) ((if nodevs then []
 185                                       else [(cellHtml [] (bold [] (htmlStr "-1 s.d.")))
 186                                             +-+ tableRow (-1) ("", lows),
 187                                             (cellHtml [] (bold [] (htmlStr "+1 s.d.")))
 188                                             +-+ tableRow (-1) ("", highs)])
 189                            ++ [cellHtml [] (bold [] (htmlStr "Average"))
 190                                +-+ tableRow (-1) ("", gms)])
 191
 192   where
 193         base_results = fmToList r :: [(String,Results)]
 194
 195         -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
 196         results_per_prog_mod_run = map get_results_for_prog base_results
 197
 198         -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
 199         get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
 200
 201            where fms = map get_run_results rs
 202
 203                  get_run_results fm = case lookupFM fm prog of
 204                                         Nothing  -> emptyFM
 205                                         Just res -> f res
 206
 207                  get_results_for_mod (id,attr) = calc_result fms Just (const Success)
 208                                                              result_ok (id,attr)
 209
 210         show_results_for_prog (prog,mrs) =
 211             cellHtml [valign "top"] (bold [] (htmlStr prog))
 212             +-+ (if null mrs then
 213                    cellHtml [] (htmlStr "(no modules compiled)")
 214                  else
 215                    foldr1 (+/+) (map (tableRow 0) mrs))
 216
 217         results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
 218                                            (_,xs) <- mods]
 219         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 220
 221 tableRow :: Result a => Int -> (String, [BoxValue a]) -> HtmlTable
 222 tableRow row_no (prog, results)
 223         =   cellHtml [bgcolor left_column_color] (htmlStr prog)
 224         +-+ foldr1 (+-+) (map (cellHtml [align "right", clr]
 225                                . htmlStr . show_box) results)
 226   where clr | row_no < 0  = bgcolor average_row_color
 227             | even row_no = bgcolor even_row_color
 228             | otherwise   = bgcolor odd_row_color
 229
 230 left_column_color = "#d0d0ff"  -- light blue
 231 odd_row_color     = "#d0d0ff"  -- light blue
 232 even_row_color    = "#f0f0ff"  -- v. light blue
 233 average_row_color = "#ffd0d0"  -- light red
 234
 235 {-
 236 findBest :: Result a => [BoxValue a] -> [(Bool,BoxValue a)]
 237 findBest stuff@(Result base : rest)
 238   = map (\a -> (a==base, a))
 239   where
 240         best = snd (minimumBy (\a b -> fst a < fst b) no_pcnt_stuff
 241
 242         no_pcnt_stuff = map unPcnt stuff
 243
 244         unPcnt (r@(Percentage f) : rest) = (base * f/100, r) : unPcnt rest
 245         unPcnt (r@(Result a) : rest)     = (a, r) : unPcnt rest
 246         unPcnt (_ : rest)                = unPcnt rest
 247 -}
 248
 249 logHeaders ss
 250   = foldr1 (+-+) (map (\s -> cellHtml [align "right", width "100"]
 251         (bold [] (htmlStr s))) ss)
 252
 253 mkTable :: HtmlTable -> Html
 254 mkTable = renderTable [cellspacing 0, cellpadding 0, border 0]
 255
 256 tabHeader ss
 257   =   cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
 258   +-+ logHeaders ss
 259
 260 multiTabHeader ss
 261   =   cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
 262   +-+ cellHtml [align "left", width "100"] (bold [] (htmlStr "Module"))
 263   +-+ logHeaders ss
 264
 265 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
 266
 267 calcColor :: Int -> String
 268 calcColor p | p >= 0    = "#"     ++ (showHex red 2 "0000")
 269               | otherwise = "#0000" ++ (showHex blue 2 "")
 270         where red  = p * 255 `div` 100
 271               blue = (-p) * 255 `div` 100
 272
 273 showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s
 274 showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s)
 275
 276 hexDig i | i > 10 = chr (i-10 + ord 'a')
 277          | otherwise = chr (i + ord '0')
 278
 279 -----------------------------------------------------------------------------
 280 -- ASCII page generation
 281
 282 asciiPage results args =
 283   ( str reportTitle
 284   . str "\n\n"
 285   . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
 286   . str "\n"
 287   . interleave "\n\n" (map (asciiGenModTable results args)  per_module_result_tab)
 288   ) "\n"
 289
 290 asciiGenProgTable results args (SpecP title anc get_result get_status result_ok)
 291   = str title
 292   . str "\n"
 293   . ascii_show_results results args get_result get_status result_ok
 294
 295 asciiGenModTable results args (SpecM title anc get_result result_ok)
 296   = str title
 297   . str "\n"
 298   . ascii_show_multi_results results args get_result result_ok
 299
 300 ascii_header ss
 301         = str "\n-------------------------------------------------------------------------------\n"
 302         . str (rjustify 15 "Program")
 303         . str (space 5)
 304         . foldr (.) id (map (str . rjustify fIELD_WIDTH) ss)
 305         . str "\n-------------------------------------------------------------------------------\n"
 306
 307 ascii_show_results
 308    :: Result a
 309         => [ResultTable]
 310         -> [String]
 311         -> (Results -> Maybe a)
 312         -> (Results -> Status)
 313         -> (a -> Bool)
 314         -> ShowS
 315
 316 ascii_show_results (r:rs) ss f stat result_ok
 317         = ascii_header ss
 318         . interleave "\n" (map show_per_prog_results results_per_prog)
 319         . if nodevs then id
 320                     else   str "\n"
 321                          . show_per_prog_results ("-1 s.d.",lows)
 322                          . str "\n"
 323                          . show_per_prog_results ("+1 s.d.",highs)
 324         . str "\n"
 325         . show_per_prog_results ("Average",gms)
 326  where
 327         -- results_per_prog :: [ (String,[BoxValue a]) ]
 328         results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
 329
 330         results_per_run  = transpose (map snd results_per_prog)
 331         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 332
 333 ascii_show_multi_results
 334    :: Result a
 335         => [ResultTable]
 336         -> [String]
 337         -> (Results -> FiniteMap String a)
 338         -> (a -> Bool)
 339         -> ShowS
 340
 341 ascii_show_multi_results (r:rs) ss f result_ok
 342         = ascii_header ss
 343         . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
 344         . str "\n"
 345         . if nodevs then id
 346                     else   str "\n"
 347                          . show_per_prog_results ("-1 s.d.",lows)
 348                          . str "\n"
 349                          . show_per_prog_results ("+1 s.d.",highs)
 350         . str "\n"
 351         . show_per_prog_results ("Average",gms)
 352   where
 353         base_results = fmToList r :: [(String,Results)]
 354
 355         -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
 356         results_per_prog_mod_run = map get_results_for_prog base_results
 357
 358         -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
 359         get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
 360
 361            where fms = map get_run_results rs
 362
 363                  get_run_results fm = case lookupFM fm prog of
 364                                         Nothing  -> emptyFM
 365                                         Just res -> f res
 366
 367                  get_results_for_mod (id,attr) = calc_result fms Just (const Success)
 368                                                              result_ok (id,attr)
 369
 370         show_results_for_prog (prog,mrs) =
 371               str ("\n"++prog++"\n")
 372             . (if null mrs then
 373                    str "(no modules compiled)\n"
 374                  else
 375                    interleave "\n" (map show_per_prog_results mrs))
 376
 377         results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
 378                                            (_,xs) <- mods]
 379         (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 380
 381 show_per_prog_results :: Result a => (String, [BoxValue a]) -> ShowS
 382 show_per_prog_results (prog,results)
 383         = str (rjustify 15 prog)
 384         . str (space 5)
 385         . foldr (.) id (map (str . rjustify fIELD_WIDTH . show_box) results)
 386
 387 -----------------------------------------------------------------------------
 388 -- Show the Results
 389
 390 class Num a => Result a where
 391         result_to_string :: a -> String
 392         convert_to_percentage :: a -> a -> Float
 393
 394 -- We assume an Int is a size, and print it in kilobytes.
 395
 396 instance Result Int where
 397         convert_to_percentage 0 size = 100
 398         convert_to_percentage base size = (fromInt size / fromInt base) * 100
 399
 400         result_to_string n = show (n `div` 1024) ++ "k"
 401
 402 instance Result Integer where
 403         convert_to_percentage 0 size = 100
 404         convert_to_percentage base size = (fromInteger size / fromInteger base) * 100
 405
 406         result_to_string n = show (n `quot` 1024) ++ "k"
 407
 408 instance Result Float where
 409         convert_to_percentage 0.0 size = 100.0
 410         convert_to_percentage base size = size / base * 100
 411
 412         result_to_string = showFloat' Nothing (Just 2)
 413
 414 data BoxValue a = RunFailed Status | Percentage Float | Result a
 415
 416 -- calc_result is a nice exercise in higher-order programming...
 417 calc_result
 418   :: Result a
 419         => [FiniteMap String b]         -- accumulated results
 420         -> (b -> Maybe a)               -- get a result from the b
 421         -> (b -> Status)                -- get a status from the b
 422         -> (a -> Bool)                  -- is this result ok?
 423         -> (String,b)                   -- the baseline result
 424         -> (String,[BoxValue a])
 425
 426 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
 427         (prog, (just_result baseline base_stat :
 428
 429           let
 430                 rts' = map (\rt -> get_stuff (lookupFM rt prog)) rts
 431
 432                 get_stuff Nothing  = (Nothing, NotDone)
 433                 get_stuff (Just r) = (get_maybe_a r, get_stat r)
 434           in
 435           (
 436           case baseline of
 437                 Just base | result_ok base
 438                    -> map (\(r,s) -> percentage  r s base) rts'
 439                 _other
 440                    -> map (\(r,s) -> just_result r s) rts'
 441            )))
 442  where
 443         baseline  = get_maybe_a base_r
 444         base_stat = get_stat base_r
 445
 446         just_result Nothing  s = RunFailed s
 447         just_result (Just a) s = Result a
 448
 449         percentage Nothing   s base = RunFailed s
 450         percentage (Just a)  s base = Percentage
 451                                          (convert_to_percentage base a)
 452 show_box (RunFailed s)  = show_stat s
 453 show_box (Percentage p) = show_pcntage p
 454 show_box (Result a)     = result_to_string a
 455
 456 -----------------------------------------------------------------------------
 457 -- Calculating geometric means and standard deviations
 458
 459 {-
 460 This is done using the log method, to avoid needing really large
 461 intermediate results.  The formula for a geometric mean is
 462
 463         (a1 * .... * an) ^ 1/n
 464
 465 which is equivalent to
 466
 467         e ^ ( (log a1 + ... + log an) / n )
 468
 469 where log is the natural logarithm function.
 470
 471 Similarly, to compute the geometric standard deviation we compute the
 472 deviation of each log, take the root-mean-square, and take the
 473 exponential again:
 474
 475         e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
 476
 477 where lbar is the mean log,
 478
 479         (log a1 + ... + log an) / n
 480
 481 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
 482 not subtract 100 from gm before performing this calculation.
 483
 484 We therefore return a (low, mean, high) triple.
 485
 486 -}
 487
 488 calc_gmsd :: [BoxValue a] -> (BoxValue Float, BoxValue Float, BoxValue Float)
 489 calc_gmsd xs
 490   | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
 491   | otherwise        = let sqr x = x * x
 492                            len   = fromInt (length percentages)
 493                            logs  = map log percentages
 494                            lbar  = sum logs / len
 495                            devs  = map (sqr . (lbar-)) logs
 496                            dbar  = sum devs / len
 497                            gm    = exp lbar
 498                            sdf   = exp (sqrt dbar)
 499                        in
 500                        (Percentage (gm/sdf),
 501                         Percentage gm,
 502                         Percentage (gm*sdf))
 503  where
 504   percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
 505         -- can't do log(0.0), so exclude zeros
 506         -- small values have inordinate effects so cap at -95%.
 507
 508 -----------------------------------------------------------------------------
 509 -- Generic stuff for results generation
 510
 511 show_pcntage n = show_float_signed (n-100) ++ "%"
 512
 513 show_float_signed = showFloat False False True False False Nothing (Just 2)
 514
 515 show_stat Success     = "(no result)"
 516 show_stat WrongStdout = "(stdout)"
 517 show_stat WrongStderr = "(stderr)"
 518 show_stat (Exit x)    = "exit(" ++ show x ++")"
 519 show_stat OutOfHeap   = "(heap)"
 520 show_stat OutOfStack  = "(stack)"
 521 show_stat NotDone     = "-----"
 522
 523 str = showString
 524
 525 interleave s = foldr1 (\a b -> a . str s . b)
 526
 527 fIELD_WIDTH = 16 :: Int
 528
 529 -----------------------------------------------------------------------------