1 -----------------------------------------------------------------------------
3 -- (c) Simon Marlow 1997-2005
5 -----------------------------------------------------------------------------
7 module Slurp (Status(..), Results(..), ResultTable, parse_log) where
10 import qualified Data.Map as Map
16 -----------------------------------------------------------------------------
17 -- This is the structure into which we collect our results:
19 type ResultTable = Map String Results
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,
37 mut_elapsed_time :: [Float],
38 instrs :: Maybe Integer,
39 mem_reads :: Maybe Integer,
40 mem_writes :: Maybe Integer,
41 cache_misses :: Maybe Integer,
42 gc_work :: Maybe Integer,
44 gc_elapsed_time :: [Float],
45 allocs :: Maybe Integer,
47 compile_status :: Status
50 emptyResults :: Results
51 emptyResults = Results {
52 compile_time = Map.empty,
53 module_size = Map.empty,
54 binary_size = Nothing,
58 mut_elapsed_time = [],
62 cache_misses = Nothing,
67 compile_status = NotDone,
71 -----------------------------------------------------------------------------
77 ==nofib== awards: size of QSort.o follows...
78 ==nofib== banner: size of banner follows...
79 ==nofib== awards: time to link awards follows...
80 ==nofib== awards: time to run awards follows...
81 ==nofib== boyer2: time to compile Checker follows...
84 -- NB. the hyphen must come last (or first) inside [...] to stand for itself.
86 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"
89 This regexp for the output of "time" works on FreeBSD, other versions
90 of "time" will need different regexps.
93 time_re :: String -> Maybe (Float, Float, Float)
94 time_re s = case matchRegex re s of
95 Just [real, user, system] ->
96 Just (read real, read user, read system)
97 Just _ -> error "time_re: Can't happen"
99 where re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
101 time_gnu17_re :: String -> Maybe (Float, Float, String)
102 time_gnu17_re s = case matchRegex re s of
103 Just [user, system, elapsed] ->
104 Just (read user, read system, elapsed)
105 Just _ -> error "time_gnu17_re: Can't happen"
107 where re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
108 -- /usr/bin/time --version reports: GNU time 1.7
109 -- notice the order is different, and the elapsed time
112 size_re :: String -> Maybe (Int, Int, Int)
113 size_re s = case matchRegex re s of
114 Just [text, datas, bss] ->
115 Just (read text, read datas, read bss)
116 Just _ -> error "size_re: Can't happen"
118 where re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
121 <<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>>
123 = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
124 init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
126 ghc1_re = pre GHC 4.02
127 ghc2_re = GHC 4.02 (includes "xxM in use")
128 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
131 ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
132 ghc1_re s = case matchRegex re s of
133 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
134 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)
135 Just _ -> error "ghc1_re: Can't happen"
137 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>>"
139 ghc2_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
140 ghc2_re s = case matchRegex re s of
141 Just [allocations, gcs, avg_residency, max_residency, samples, in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
142 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)
143 Just _ -> error "ghc2_re: Can't happen"
145 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>>"
147 ghc3_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
148 ghc3_re s = case matchRegex re s of
149 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
150 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)
151 Just _ -> error "ghc3_re: Can't happen"
153 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>>"
155 ghc4_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float, Integer, Integer, Integer, Integer)
156 ghc4_re s = case matchRegex re s of
157 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] ->
158 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)
159 Just _ -> error "ghc4_re: Can't happen"
161 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>>"
163 wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex
164 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
165 wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
166 out_of_heap = mkRegex "^\\+ Heap exhausted;$"
167 out_of_stack = mkRegex "^\\+ Stack space overflow:"
169 parse_log :: String -> ResultTable
171 = combine_results -- collate information
173 . map process_chunk -- get information from each chunk
174 . tail -- first chunk is junk
175 . chunk_log [] [] -- break at banner lines
178 combine_results :: [(String,Results)] -> Map String Results
179 combine_results = foldr f Map.empty
181 f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm
183 combine2Results :: Results -> Results -> Results
185 Results{ compile_time = ct1, link_time = lt1,
187 run_time = rt1, mut_time = mt1,
188 mut_elapsed_time = me1,
189 instrs = is1, mem_reads = mr1, mem_writes = mw1,
191 gc_time = gt1, gc_elapsed_time = ge1, gc_work = gw1,
192 binary_size = bs1, allocs = al1,
193 run_status = rs1, compile_status = cs1 }
194 Results{ compile_time = ct2, link_time = lt2,
196 run_time = rt2, mut_time = mt2,
197 mut_elapsed_time = me2,
198 instrs = is2, mem_reads = mr2, mem_writes = mw2,
200 gc_time = gt2, gc_elapsed_time = ge2, gc_work = gw2,
201 binary_size = bs2, allocs = al2,
202 run_status = rs2, compile_status = cs2 }
203 = Results{ compile_time = Map.unionWith (flip const) ct1 ct2,
204 module_size = Map.unionWith (flip const) ms1 ms2,
205 link_time = lt1 `mplus` lt2,
206 run_time = rt1 ++ rt2,
207 mut_time = mt1 ++ mt2,
208 mut_elapsed_time = me1 ++ me2,
209 instrs = is1 `mplus` is2,
210 mem_reads = mr1 `mplus` mr2,
211 mem_writes = mw1 `mplus` mw2,
212 cache_misses = cm1 `mplus` cm2,
213 gc_time = gt1 ++ gt2,
214 gc_elapsed_time= ge1 ++ ge2,
215 gc_work = gw1 `mplus` gw2,
216 binary_size = bs1 `mplus` bs2,
217 allocs = al1 `mplus` al2,
218 run_status = combStatus rs1 rs2,
219 compile_status = combStatus cs1 cs2 }
221 combStatus :: Status -> Status -> Status
222 combStatus NotDone y = y
223 combStatus x NotDone = x
226 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
227 chunk_log header chunk [] = [(header,chunk)]
228 chunk_log header chunk (l:ls) =
229 case matchRegex banner_re l of
230 Nothing -> chunk_log header (l:chunk) ls
231 Just stuff -> (header,chunk) : chunk_log stuff [] ls
233 process_chunk :: ([String],[String]) -> [(String,Results)]
234 process_chunk (progName : what : modName : _, chk) =
236 "time to compile" -> parse_compile_time progName modName chk
237 "time to run" -> parse_run_time progName (reverse chk) emptyResults NotDone
238 "time to compile & run" -> parse_compile_time progName modName chk
239 ++ parse_run_time progName (reverse chk) emptyResults NotDone
240 "time to link" -> parse_link_time progName chk
241 "size of" -> parse_size progName modName chk
242 _ -> error ("process_chunk: "++what)
243 process_chunk _ = error "process_chunk: Can't happen"
245 parse_compile_time :: String -> String -> [String] -> [(String, Results)]
246 parse_compile_time _ _ [] = []
247 parse_compile_time progName modName (l:ls) =
249 Just (_real, user, _system) ->
250 let ct = Map.singleton modName user
252 [(progName, emptyResults{compile_time = ct})];
255 case time_gnu17_re l of {
256 Just (user, _system, _elapsed) ->
257 let ct = Map.singleton modName user
259 [(progName, emptyResults{compile_time = ct})];
263 Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
265 time = (initialisation + mut + gc) :: Float
266 ct = Map.singleton modName time
268 [(progName, emptyResults{compile_time = ct})];
272 Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
273 let ct = Map.singleton modName (initialisation + mut + gc)
275 [(progName, emptyResults{compile_time = ct})];
279 Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
280 let ct = Map.singleton modName (initialisation + mut + gc)
282 [(progName, emptyResults{compile_time = ct})];
286 Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) ->
287 let ct = Map.singleton modName (initialisation + mut + gc)
289 [(progName, emptyResults{compile_time = ct})];
292 parse_compile_time progName modName ls
295 parse_link_time :: String -> [String] -> [(String, Results)]
296 parse_link_time _ [] = []
297 parse_link_time prog (l:ls) =
299 Just (_real, user, _system) ->
300 [(prog,emptyResults{link_time = Just user})];
303 case time_gnu17_re l of {
304 Just (user, _system, _elapsed) ->
305 [(prog,emptyResults{link_time = Just user})];
308 parse_link_time prog ls
312 -- There might be multiple runs of the program, so we have to collect up
313 -- all the results. Variable results like runtimes are aggregated into
314 -- a list, whereas the non-variable aspects are just kept singly.
315 parse_run_time :: String -> [String] -> Results -> Status
316 -> [(String, Results)]
317 parse_run_time _ [] _ NotDone = []
318 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
319 parse_run_time prog (l:ls) res ex =
321 Just (allocations, _, _, _, _, _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) ->
322 got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
323 Nothing Nothing Nothing Nothing Nothing;
327 Just (allocations, _, _, _, _, _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) ->
328 got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
329 Nothing Nothing Nothing Nothing Nothing;
334 Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) ->
335 got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
336 (Just gc_work') Nothing Nothing Nothing Nothing;
341 Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed, is, mem_rs, mem_ws, cache_misses') ->
342 got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
343 (Just gc_work') (Just is) (Just mem_rs)
344 (Just mem_ws) (Just cache_misses');
348 case matchRegex wrong_output l of {
350 parse_run_time prog ls res (combineRunResult WrongStdout ex);
352 parse_run_time prog ls res (combineRunResult WrongStderr ex);
353 Just _ -> error "wrong_output: Can't happen";
356 case matchRegex wrong_exit_status l of {
357 Just [_wanted, got] ->
358 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
359 Just _ -> error "wrong_exit_status: Can't happen";
362 case matchRegex out_of_heap l of {
364 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
367 case matchRegex out_of_stack l of {
369 parse_run_time prog ls res (combineRunResult OutOfStack ex);
371 parse_run_time prog ls res ex;
375 got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed gc_work' instrs' mem_rs mem_ws cache_misses'
376 = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
378 time = initialisation + mut + gc
379 res' = combine2Results res
380 emptyResults{ run_time = [time],
382 mut_elapsed_time = [mut_elapsed],
384 gc_elapsed_time = [gc_elapsed],
386 allocs = Just allocations,
390 cache_misses = cache_misses',
394 parse_run_time prog ls res' Success
396 combineRunResult :: Status -> Status -> Status
397 combineRunResult OutOfHeap _ = OutOfHeap
398 combineRunResult _ OutOfHeap = OutOfHeap
399 combineRunResult OutOfStack _ = OutOfStack
400 combineRunResult _ OutOfStack = OutOfStack
401 combineRunResult (Exit e) _ = Exit e
402 combineRunResult _ (Exit e) = Exit e
403 combineRunResult exit _ = exit
405 parse_size :: String -> String -> [String] -> [(String, Results)]
406 parse_size _ _ [] = []
407 parse_size progName modName (l:ls) =
409 Nothing -> parse_size progName modName ls
410 Just (text, datas, _bss)
411 | progName == modName ->
412 [(progName,emptyResults{binary_size =
414 compile_status = Success})]
416 let ms = Map.singleton modName (text + datas)
418 [(progName,emptyResults{module_size = ms})]