glafp-utils/nofib-analyse/Slurp.hs

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