utils/nofib-analyse/Slurp.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- (c) Simon Marlow 1997-2005
   4 --
   5 -----------------------------------------------------------------------------
   6
   7 module Slurp (Status(..), Results(..), ResultTable, parse_log) where
   8
   9 import Control.Monad
  10 import qualified Data.Map as Map
  11 import Data.Map (Map)
  12 import Text.Regex
  13 import Data.Maybe
  14 -- import Debug.Trace
  15
  16 -----------------------------------------------------------------------------
  17 -- This is the structure into which we collect our results:
  18
  19 type ResultTable = Map String Results
  20
  21 data Status
  22         = NotDone
  23         | Success
  24         | OutOfHeap
  25         | OutOfStack
  26         | Exit Int
  27         | WrongStdout
  28         | WrongStderr
  29
  30 data Results = Results {
  31         compile_time    :: Map String Float,
  32         module_size     :: Map String Int,
  33         binary_size     :: Maybe Int,
  34         link_time       :: Maybe Float,
  35         run_time        :: [Float],
  36         mut_time        :: [Float],
  37         instrs          :: Maybe Integer,
  38         mem_reads       :: Maybe Integer,
  39         mem_writes      :: Maybe Integer,
  40         cache_misses    :: Maybe Integer,
  41         gc_work         :: Maybe Integer,
  42         gc_time         :: [Float],
  43         allocs          :: Maybe Integer,
  44         run_status      :: Status,
  45         compile_status  :: Status
  46         }
  47
  48 emptyResults :: Results
  49 emptyResults = Results {
  50         compile_time    = Map.empty,
  51         module_size     = Map.empty,
  52         binary_size     = Nothing,
  53         link_time       = Nothing,
  54         run_time        = [],
  55         mut_time        = [],
  56         instrs          = Nothing,
  57         mem_reads       = Nothing,
  58         mem_writes      = Nothing,
  59         cache_misses    = Nothing,
  60         gc_time         = [],
  61         gc_work         = Nothing,
  62         allocs          = Nothing,
  63         compile_status  = NotDone,
  64         run_status      = NotDone
  65         }
  66
  67 -----------------------------------------------------------------------------
  68 -- Parse the log file
  69
  70 {-
  71 Various banner lines:
  72
  73 ==nofib== awards: size of QSort.o follows...
  74 ==nofib== banner: size of banner follows...
  75 ==nofib== awards: time to link awards follows...
  76 ==nofib== awards: time to run awards follows...
  77 ==nofib== boyer2: time to compile Checker follows...
  78 -}
  79
  80 -- NB. the hyphen must come last (or first) inside [...] to stand for itself.
  81 banner_re :: Regex
  82 banner_re = mkRegex "^==nofib==[ \t]+([A-Za-z0-9_-]+):[ \t]+(size of|time to link|time to run|time to compile)[ \t]+([A-Za-z0-9_-]+)(\\.o)?[ \t]+follows"
  83
  84 {-
  85 This regexp for the output of "time" works on FreeBSD, other versions
  86 of "time" will need different regexps.
  87 -}
  88
  89 time_re :: Regex
  90 time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
  91
  92 time_gnu17_re :: Regex
  93 time_gnu17_re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
  94                 -- /usr/bin/time --version reports: GNU time 1.7
  95                 -- notice the order is different, and the elapsed time is [hh:]mm:ss.s
  96
  97 size_re :: Regex
  98 size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
  99
 100 {-
 101 <<ghc: 5820820 bytes, 0 GCs, 0/0 avg/max bytes residency (0 samples), 41087234 bytes GC work, 0.00 INIT (0.05 elapsed), 0.08 MUT (0.18 elapsed), 0.00 GC (0.00 elapsed) :ghc>>
 102
 103         = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
 104            init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
 105
 106 ghc1_re = pre GHC 4.02
 107 ghc2_re = GHC 4.02 (includes "xxM in use")
 108 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
 109 -}
 110
 111 ghc1_re, ghc2_re, ghc3_re, ghc4_re :: Regex
 112 ghc1_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
 113
 114 ghc2_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
 115
 116 ghc3_re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\) :ghc>>"
 117
 118 ghc4_re = mkRegex "^<<ghc-instrs:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9]+) instructions, ([0-9]+) memory reads, ([0-9]+) memory writes, ([0-9]+) L2 cache misses :ghc-instrs>>"
 119
 120 wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex
 121 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
 122 wrong_output      = mkRegex "^expected (stdout|stderr) not matched by reality$"
 123 out_of_heap       = mkRegex "^\\+ Heap exhausted;$"
 124 out_of_stack      = mkRegex "^\\+ Stack space overflow:"
 125
 126 parse_log :: String -> ResultTable
 127 parse_log
 128         = combine_results               -- collate information
 129         . concat
 130         . map process_chunk             -- get information from each chunk
 131         . tail                          -- first chunk is junk
 132         . chunk_log [] []               -- break at banner lines
 133         . lines
 134
 135 combine_results :: [(String,Results)] -> Map String Results
 136 combine_results = foldr f Map.empty
 137  where
 138         f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm
 139
 140 combine2Results :: Results -> Results -> Results
 141 combine2Results
 142              Results{ compile_time = ct1, link_time = lt1,
 143                       module_size = ms1,
 144                       run_time = rt1, mut_time = mt1,
 145                       instrs = is1, mem_reads = mr1, mem_writes = mw1,
 146                       cache_misses = cm1,
 147                       gc_time = gt1, gc_work = gw1,
 148                       binary_size = bs1, allocs = al1,
 149                       run_status = rs1, compile_status = cs1 }
 150              Results{ compile_time = ct2, link_time = lt2,
 151                       module_size = ms2,
 152                       run_time = rt2, mut_time = mt2,
 153                       instrs = is2, mem_reads = mr2, mem_writes = mw2,
 154                       cache_misses = cm2,
 155                       gc_time = gt2, gc_work = gw2,
 156                       binary_size = bs2, allocs = al2,
 157                       run_status = rs2, compile_status = cs2 }
 158           =  Results{ compile_time   = Map.unionWith (flip const) ct1 ct2,
 159                       module_size    = Map.unionWith (flip const) ms1 ms2,
 160                       link_time      = lt1 `mplus` lt2,
 161                       run_time       = rt1 ++ rt2,
 162                       mut_time       = mt1 ++ mt2,
 163                       instrs         = is1 `mplus` is2,
 164                       mem_reads      = mr1 `mplus` mr2,
 165                       mem_writes     = mw1 `mplus` mw2,
 166                       cache_misses   = cm1 `mplus` cm2,
 167                       gc_time        = gt1 ++ gt2,
 168                       gc_work        = gw1 `mplus` gw2,
 169                       binary_size    = bs1 `mplus` bs2,
 170                       allocs         = al1 `mplus` al2,
 171                       run_status     = combStatus rs1 rs2,
 172                       compile_status = combStatus cs1 cs2 }
 173
 174 combStatus :: Status -> Status -> Status
 175 combStatus NotDone y       = y
 176 combStatus x       NotDone = x
 177 combStatus x       _       = x
 178
 179 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
 180 chunk_log header chunk [] = [(header,chunk)]
 181 chunk_log header chunk (l:ls) =
 182         case matchRegex banner_re l of
 183                 Nothing -> chunk_log header (l:chunk) ls
 184                 Just stuff -> (header,chunk) : chunk_log stuff [] ls
 185
 186 process_chunk :: ([String],[String]) -> [(String,Results)]
 187 process_chunk (progName : what : modName : _, chk) =
 188  case what of
 189         "time to compile" -> parse_compile_time progName modName chk
 190         "time to run"     -> parse_run_time progName (reverse chk) emptyResults NotDone
 191         "time to link"    -> parse_link_time progName chk
 192         "size of"         -> parse_size progName modName chk
 193         _                 -> error ("process_chunk: "++what)
 194 process_chunk _ = error "process_chunk: Can't happen"
 195
 196 parse_compile_time :: String -> String -> [String] -> [(String, Results)]
 197 parse_compile_time _    _   [] = []
 198 parse_compile_time progName modName (l:ls) =
 199         case matchRegex time_re l of {
 200              Just (_real:user:_system:_) ->
 201                 let ct  = Map.singleton modName (read user)
 202                 in
 203                 [(progName, emptyResults{compile_time = ct})];
 204              Nothing ->
 205
 206         case matchRegex time_gnu17_re l of {
 207              Just (user:_system:_elapsed:_) ->
 208                 let ct  = Map.singleton modName (read user)
 209                 in
 210                 [(progName, emptyResults{compile_time = ct})];
 211              Nothing ->
 212
 213         case matchRegex ghc1_re l of {
 214             Just (_allocations:_:_:_:_:initialisation:_:mut:_:gc:_) ->
 215               let
 216                   read_mut = read mut
 217                   read_gc  = read gc
 218                   time = (read initialisation + read_mut + read_gc) :: Float
 219                   ct  = Map.singleton modName time
 220               in
 221                 [(progName, emptyResults{compile_time = ct})];
 222             Nothing ->
 223
 224         case matchRegex ghc2_re l of {
 225            Just (_allocations:_:_:_:_:_:initialisation:_:mut:_:gc:_) ->
 226               let
 227                   read_mut = read mut
 228                   read_gc  = read gc
 229                   time = (read initialisation + read_mut + read_gc) :: Float
 230                   ct  = Map.singleton modName time
 231               in
 232                 [(progName, emptyResults{compile_time = ct})];
 233             Nothing ->
 234
 235         case matchRegex ghc3_re l of {
 236            Just (_allocations:_:_:_:_:_:_:initialisation:_:mut:_:gc:_) ->
 237               let
 238                   read_mut = read mut
 239                   read_gc  = read gc
 240                   time = (read initialisation + read_mut + read_gc) :: Float
 241                   ct  = Map.singleton modName time
 242               in
 243                 [(progName, emptyResults{compile_time = ct})];
 244             Nothing ->
 245
 246         case matchRegex ghc4_re l of {
 247            Just (_allocations:_:_:_:_:_:_:initialisation:_:mut:_:gc:_:_:_:_) ->
 248               let
 249                   read_mut = read mut
 250                   read_gc  = read gc
 251                   time = (read initialisation + read_mut + read_gc) :: Float
 252                   ct  = Map.singleton modName time
 253               in
 254                 [(progName, emptyResults{compile_time = ct})];
 255             Nothing ->
 256
 257                 parse_compile_time progName modName ls
 258         }}}}}}
 259
 260 parse_link_time :: String -> [String] -> [(String, Results)]
 261 parse_link_time _ [] = []
 262 parse_link_time prog (l:ls) =
 263           case matchRegex time_re l of {
 264              Just (_real:user:_system:_) ->
 265                 [(prog,emptyResults{link_time = Just (read user)})];
 266              Nothing ->
 267
 268           case matchRegex time_gnu17_re l of {
 269              Just (user:_system:_elapsed:_) ->
 270                 [(prog,emptyResults{link_time = Just (read user)})];
 271              Nothing ->
 272
 273           parse_link_time prog ls
 274           }}
 275
 276
 277 -- There might be multiple runs of the program, so we have to collect up
 278 -- all the results.  Variable results like runtimes are aggregated into
 279 -- a list, whereas the non-variable aspects are just kept singly.
 280 parse_run_time :: String -> [String] -> Results -> Status
 281                -> [(String, Results)]
 282 parse_run_time _ [] _ NotDone = []
 283 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
 284 parse_run_time prog (l:ls) res ex =
 285         case matchRegex ghc1_re l of {
 286            Just (allocations:_:_:_:_:initialisation:_:mut:_:gc:_) ->
 287                 got_run_result allocations initialisation mut gc Nothing
 288                         Nothing Nothing Nothing Nothing;
 289            Nothing ->
 290
 291         case matchRegex ghc2_re l of {
 292            Just (allocations:_:_:_:_:_:initialisation:_:mut:_:gc:_) ->
 293                 got_run_result allocations initialisation mut gc Nothing
 294                         Nothing Nothing Nothing Nothing;
 295
 296             Nothing ->
 297
 298         case matchRegex ghc3_re l of {
 299            Just (allocations:_:_:_:_:gc_work':_:initialisation:_:mut:_:gc:_) ->
 300                 got_run_result allocations initialisation mut gc (Just (read gc_work'))
 301                         Nothing Nothing Nothing Nothing;
 302
 303             Nothing ->
 304
 305         case matchRegex ghc4_re l of {
 306            Just (allocations:_:_:_:_:gc_work':_:initialisation:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses':_) ->
 307                 got_run_result allocations initialisation mut gc (Just (read gc_work'))
 308                         (Just (read is)) (Just (read mem_rs))
 309                         (Just (read mem_ws)) (Just (read cache_misses'));
 310
 311             Nothing ->
 312
 313         case matchRegex wrong_output l of {
 314             Just ("stdout":_) ->
 315                 parse_run_time prog ls res (combineRunResult WrongStdout ex);
 316             Just ("stderr":_) ->
 317                 parse_run_time prog ls res (combineRunResult WrongStderr ex);
 318             Nothing ->
 319
 320         case matchRegex wrong_exit_status l of {
 321             Just (_wanted:got:_) ->
 322                 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
 323             Nothing ->
 324
 325         case matchRegex out_of_heap l of {
 326             Just _ ->
 327                 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
 328             Nothing ->
 329
 330         case matchRegex out_of_stack l of {
 331             Just _ ->
 332                 parse_run_time prog ls res (combineRunResult OutOfStack ex);
 333             Nothing ->
 334                 parse_run_time prog ls res ex;
 335
 336         }}}}}}}}
 337   where
 338   got_run_result allocations initialisation mut gc gc_work' instrs' mem_rs mem_ws cache_misses'
 339       = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
 340         let
 341           read_mut = read mut
 342           read_gc  = read gc
 343           time = (read initialisation + read_mut + read_gc) :: Float
 344           res' = combine2Results res
 345                         emptyResults{   run_time   = [time],
 346                                         mut_time   = [read_mut],
 347                                         gc_time    = [read_gc],
 348                                         gc_work    = gc_work',
 349                                         allocs     = Just (read allocations),
 350                                         instrs     = instrs',
 351                                         mem_reads  = mem_rs,
 352                                         mem_writes = mem_ws,
 353                                         cache_misses = cache_misses',
 354                                         run_status = Success
 355                                 }
 356         in
 357         parse_run_time prog ls res' Success
 358
 359 combineRunResult :: Status -> Status -> Status
 360 combineRunResult OutOfHeap  _           = OutOfHeap
 361 combineRunResult _          OutOfHeap   = OutOfHeap
 362 combineRunResult OutOfStack _           = OutOfStack
 363 combineRunResult _          OutOfStack  = OutOfStack
 364 combineRunResult (Exit e)   _           = Exit e
 365 combineRunResult _          (Exit e)    = Exit e
 366 combineRunResult exit       _            = exit
 367
 368 parse_size :: String -> String -> [String] -> [(String, Results)]
 369 parse_size _ _ [] = []
 370 parse_size progName modName (l:ls) =
 371         case matchRegex size_re l of
 372             Nothing -> parse_size progName modName ls
 373             Just (text:datas:_bss:_)
 374                  | progName == modName ->
 375                         [(progName,emptyResults{binary_size =
 376                                               Just (read text + read datas),
 377                                     compile_status = Success})]
 378                  | otherwise ->
 379                         let ms  = Map.singleton modName (read text + read datas)
 380                         in
 381                         [(progName,emptyResults{module_size = ms})]
 382