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|time to compile & run)[ \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 :: String -> Maybe (Float, Float, Float)
  90 time_re s = case matchRegex re s of
  91                 Just [real, user, system] ->
  92                     Just (read real, read user, read system)
  93                 Just _ -> error "time_re: Can't happen"
  94                 Nothing -> Nothing
  95     where re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
  96
  97 time_gnu17_re :: String -> Maybe (Float, Float, String)
  98 time_gnu17_re s = case matchRegex re s of
  99                       Just [user, system, elapsed] ->
 100                           Just (read user, read system, elapsed)
 101                       Just _ -> error "time_gnu17_re: Can't happen"
 102                       Nothing -> Nothing
 103     where re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
 104           -- /usr/bin/time --version reports: GNU time 1.7
 105           -- notice the order is different, and the elapsed time
 106           -- is [hh:]mm:ss.s
 107
 108 size_re :: String -> Maybe (Int, Int, Int)
 109 size_re s = case matchRegex re s of
 110                 Just [text, datas, bss] ->
 111                     Just (read text, read datas, read bss)
 112                 Just _ -> error "size_re: Can't happen"
 113                 Nothing -> Nothing
 114     where re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
 115
 116 {-
 117 <<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>>
 118
 119         = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
 120            init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
 121
 122 ghc1_re = pre GHC 4.02
 123 ghc2_re = GHC 4.02 (includes "xxM in use")
 124 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
 125 -}
 126
 127 ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
 128 ghc1_re s = case matchRegex re s of
 129                 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
 130                     Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed)
 131                 Just _ -> error "ghc1_re: Can't happen"
 132                 Nothing -> Nothing
 133     where 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>>"
 134
 135 ghc2_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
 136 ghc2_re s = case matchRegex re s of
 137                 Just [allocations, gcs, avg_residency, max_residency, samples, in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
 138                     Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed)
 139                 Just _ -> error "ghc2_re: Can't happen"
 140                 Nothing -> Nothing
 141     where 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>>"
 142
 143 ghc3_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
 144 ghc3_re s = case matchRegex re s of
 145                 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
 146                     Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed)
 147                 Just _ -> error "ghc3_re: Can't happen"
 148                 Nothing -> Nothing
 149     where 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>>"
 150
 151 ghc4_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float, Integer, Integer, Integer, Integer)
 152 ghc4_re s = case matchRegex re s of
 153                 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed, instructions, memory_reads, memory_writes, l2_cache_misses] ->
 154                     Just (read allocations, read gcs, read avg_residency, read max_residency, read samples, read gc_work', read in_use, read initialisation, read initialisation_elapsed, read mut, read mut_elapsed, read gc, read gc_elapsed, read instructions, read memory_reads, read memory_writes, read l2_cache_misses)
 155                 Just _ -> error "ghc4_re: Can't happen"
 156                 Nothing -> Nothing
 157     where 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>>"
 158
 159 wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex
 160 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
 161 wrong_output      = mkRegex "^expected (stdout|stderr) not matched by reality$"
 162 out_of_heap       = mkRegex "^\\+ Heap exhausted;$"
 163 out_of_stack      = mkRegex "^\\+ Stack space overflow:"
 164
 165 parse_log :: String -> ResultTable
 166 parse_log
 167         = combine_results               -- collate information
 168         . concat
 169         . map process_chunk             -- get information from each chunk
 170         . tail                          -- first chunk is junk
 171         . chunk_log [] []               -- break at banner lines
 172         . lines
 173
 174 combine_results :: [(String,Results)] -> Map String Results
 175 combine_results = foldr f Map.empty
 176  where
 177         f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm
 178
 179 combine2Results :: Results -> Results -> Results
 180 combine2Results
 181              Results{ compile_time = ct1, link_time = lt1,
 182                       module_size = ms1,
 183                       run_time = rt1, mut_time = mt1,
 184                       instrs = is1, mem_reads = mr1, mem_writes = mw1,
 185                       cache_misses = cm1,
 186                       gc_time = gt1, gc_work = gw1,
 187                       binary_size = bs1, allocs = al1,
 188                       run_status = rs1, compile_status = cs1 }
 189              Results{ compile_time = ct2, link_time = lt2,
 190                       module_size = ms2,
 191                       run_time = rt2, mut_time = mt2,
 192                       instrs = is2, mem_reads = mr2, mem_writes = mw2,
 193                       cache_misses = cm2,
 194                       gc_time = gt2, gc_work = gw2,
 195                       binary_size = bs2, allocs = al2,
 196                       run_status = rs2, compile_status = cs2 }
 197           =  Results{ compile_time   = Map.unionWith (flip const) ct1 ct2,
 198                       module_size    = Map.unionWith (flip const) ms1 ms2,
 199                       link_time      = lt1 `mplus` lt2,
 200                       run_time       = rt1 ++ rt2,
 201                       mut_time       = mt1 ++ mt2,
 202                       instrs         = is1 `mplus` is2,
 203                       mem_reads      = mr1 `mplus` mr2,
 204                       mem_writes     = mw1 `mplus` mw2,
 205                       cache_misses   = cm1 `mplus` cm2,
 206                       gc_time        = gt1 ++ gt2,
 207                       gc_work        = gw1 `mplus` gw2,
 208                       binary_size    = bs1 `mplus` bs2,
 209                       allocs         = al1 `mplus` al2,
 210                       run_status     = combStatus rs1 rs2,
 211                       compile_status = combStatus cs1 cs2 }
 212
 213 combStatus :: Status -> Status -> Status
 214 combStatus NotDone y       = y
 215 combStatus x       NotDone = x
 216 combStatus x       _       = x
 217
 218 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
 219 chunk_log header chunk [] = [(header,chunk)]
 220 chunk_log header chunk (l:ls) =
 221         case matchRegex banner_re l of
 222                 Nothing -> chunk_log header (l:chunk) ls
 223                 Just stuff -> (header,chunk) : chunk_log stuff [] ls
 224
 225 process_chunk :: ([String],[String]) -> [(String,Results)]
 226 process_chunk (progName : what : modName : _, chk) =
 227  case what of
 228         "time to compile" -> parse_compile_time progName modName chk
 229         "time to run"     -> parse_run_time progName (reverse chk) emptyResults NotDone
 230         "time to compile & run" -> parse_compile_time progName modName chk
 231                                 ++ parse_run_time progName (reverse chk) emptyResults NotDone
 232         "time to link"    -> parse_link_time progName chk
 233         "size of"         -> parse_size progName modName chk
 234         _                 -> error ("process_chunk: "++what)
 235 process_chunk _ = error "process_chunk: Can't happen"
 236
 237 parse_compile_time :: String -> String -> [String] -> [(String, Results)]
 238 parse_compile_time _    _   [] = []
 239 parse_compile_time progName modName (l:ls) =
 240         case time_re l of {
 241              Just (_real, user, _system) ->
 242                 let ct  = Map.singleton modName user
 243                 in
 244                 [(progName, emptyResults{compile_time = ct})];
 245              Nothing ->
 246
 247         case time_gnu17_re l of {
 248              Just (user, _system, _elapsed) ->
 249                 let ct  = Map.singleton modName user
 250                 in
 251                 [(progName, emptyResults{compile_time = ct})];
 252              Nothing ->
 253
 254         case ghc1_re l of {
 255             Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
 256               let
 257                   time = (initialisation + mut + gc) :: Float
 258                   ct  = Map.singleton modName time
 259               in
 260                 [(progName, emptyResults{compile_time = ct})];
 261             Nothing ->
 262
 263         case ghc2_re l of {
 264            Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
 265               let ct = Map.singleton modName (initialisation + mut + gc)
 266               in
 267                 [(progName, emptyResults{compile_time = ct})];
 268             Nothing ->
 269
 270         case ghc3_re l of {
 271            Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
 272               let ct = Map.singleton modName (initialisation + mut + gc)
 273               in
 274                 [(progName, emptyResults{compile_time = ct})];
 275             Nothing ->
 276
 277         case ghc4_re l of {
 278            Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) ->
 279               let ct = Map.singleton modName (initialisation + mut + gc)
 280               in
 281                 [(progName, emptyResults{compile_time = ct})];
 282             Nothing ->
 283
 284                 parse_compile_time progName modName ls
 285         }}}}}}
 286
 287 parse_link_time :: String -> [String] -> [(String, Results)]
 288 parse_link_time _ [] = []
 289 parse_link_time prog (l:ls) =
 290           case time_re l of {
 291              Just (_real, user, _system) ->
 292                 [(prog,emptyResults{link_time = Just user})];
 293              Nothing ->
 294
 295           case time_gnu17_re l of {
 296              Just (user, _system, _elapsed) ->
 297                 [(prog,emptyResults{link_time = Just user})];
 298              Nothing ->
 299
 300           parse_link_time prog ls
 301           }}
 302
 303
 304 -- There might be multiple runs of the program, so we have to collect up
 305 -- all the results.  Variable results like runtimes are aggregated into
 306 -- a list, whereas the non-variable aspects are just kept singly.
 307 parse_run_time :: String -> [String] -> Results -> Status
 308                -> [(String, Results)]
 309 parse_run_time _ [] _ NotDone = []
 310 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
 311 parse_run_time prog (l:ls) res ex =
 312         case ghc1_re l of {
 313            Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
 314                 got_run_result allocations initialisation mut gc Nothing
 315                         Nothing Nothing Nothing Nothing;
 316            Nothing ->
 317
 318         case ghc2_re l of {
 319            Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
 320                 got_run_result allocations initialisation mut gc Nothing
 321                         Nothing Nothing Nothing Nothing;
 322
 323             Nothing ->
 324
 325         case ghc3_re l of {
 326            Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, _, gc, _) ->
 327                 got_run_result allocations initialisation mut gc
 328                         (Just gc_work') Nothing Nothing Nothing Nothing;
 329
 330             Nothing ->
 331
 332         case ghc4_re l of {
 333            Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, _, gc, _, is, mem_rs, mem_ws, cache_misses') ->
 334                 got_run_result allocations initialisation mut gc
 335                         (Just gc_work') (Just is) (Just mem_rs)
 336                         (Just mem_ws) (Just cache_misses');
 337
 338             Nothing ->
 339
 340         case matchRegex wrong_output l of {
 341             Just ["stdout"] ->
 342                 parse_run_time prog ls res (combineRunResult WrongStdout ex);
 343             Just ["stderr"] ->
 344                 parse_run_time prog ls res (combineRunResult WrongStderr ex);
 345             Just _ -> error "wrong_output: Can't happen";
 346             Nothing ->
 347
 348         case matchRegex wrong_exit_status l of {
 349             Just [_wanted, got] ->
 350                 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
 351             Just _ -> error "wrong_exit_status: Can't happen";
 352             Nothing ->
 353
 354         case matchRegex out_of_heap l of {
 355             Just _ ->
 356                 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
 357             Nothing ->
 358
 359         case matchRegex out_of_stack l of {
 360             Just _ ->
 361                 parse_run_time prog ls res (combineRunResult OutOfStack ex);
 362             Nothing ->
 363                 parse_run_time prog ls res ex;
 364
 365         }}}}}}}}
 366   where
 367   got_run_result allocations initialisation mut gc gc_work' instrs' mem_rs mem_ws cache_misses'
 368       = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
 369         let
 370           time = initialisation + mut + gc
 371           res' = combine2Results res
 372                         emptyResults{   run_time   = [time],
 373                                         mut_time   = [mut],
 374                                         gc_time    = [gc],
 375                                         gc_work    = gc_work',
 376                                         allocs     = Just allocations,
 377                                         instrs     = instrs',
 378                                         mem_reads  = mem_rs,
 379                                         mem_writes = mem_ws,
 380                                         cache_misses = cache_misses',
 381                                         run_status = Success
 382                                 }
 383         in
 384         parse_run_time prog ls res' Success
 385
 386 combineRunResult :: Status -> Status -> Status
 387 combineRunResult OutOfHeap  _           = OutOfHeap
 388 combineRunResult _          OutOfHeap   = OutOfHeap
 389 combineRunResult OutOfStack _           = OutOfStack
 390 combineRunResult _          OutOfStack  = OutOfStack
 391 combineRunResult (Exit e)   _           = Exit e
 392 combineRunResult _          (Exit e)    = Exit e
 393 combineRunResult exit       _            = exit
 394
 395 parse_size :: String -> String -> [String] -> [(String, Results)]
 396 parse_size _ _ [] = []
 397 parse_size progName modName (l:ls) =
 398         case size_re l of
 399             Nothing -> parse_size progName modName ls
 400             Just (text, datas, _bss)
 401                  | progName == modName ->
 402                         [(progName,emptyResults{binary_size =
 403                                               Just (text + datas),
 404                                     compile_status = Success})]
 405                  | otherwise ->
 406                         let ms  = Map.singleton modName (text + datas)
 407                         in
 408                         [(progName,emptyResults{module_size = ms})]
 409