glafp-utils/nofib-analyse/Main.hs

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