1 -----------------------------------------------------------------------------
3 -- (c) Simon Marlow 1997-2005
5 -----------------------------------------------------------------------------
7 module Slurp (Status(..), Results(..), ResultTable, parse_log) where
15 -----------------------------------------------------------------------------
16 -- This is the structure into which we collect our results:
18 type ResultTable = FiniteMap String Results
29 data Results = Results {
30 compile_time :: FiniteMap String Float,
31 module_size :: FiniteMap String Int,
32 binary_size :: Maybe Int,
33 link_time :: Maybe Float,
36 instrs :: Maybe Integer,
37 mem_reads :: Maybe Integer,
38 mem_writes :: Maybe Integer,
39 cache_misses :: Maybe Integer,
40 gc_work :: Maybe Integer,
42 allocs :: Maybe Integer,
44 compile_status :: Status
47 emptyResults = Results {
48 compile_time = emptyFM,
49 module_size = emptyFM,
50 binary_size = Nothing,
57 cache_misses = Nothing,
61 compile_status = NotDone,
65 -----------------------------------------------------------------------------
71 ==nofib== awards: size of QSort.o follows...
72 ==nofib== banner: size of banner follows...
73 ==nofib== awards: time to link awards follows...
74 ==nofib== awards: time to run awards follows...
75 ==nofib== boyer2: time to compile Checker follows...
78 -- NB. the hyphen must come last (or first) inside [...] to stand for itself.
79 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"
82 This regexp for the output of "time" works on FreeBSD, other versions
83 of "time" will need different regexps.
86 time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
88 time_gnu17_re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
89 -- /usr/bin/time --version reports: GNU time 1.7
90 -- notice the order is different, and the elapsed time is [hh:]mm:ss.s
92 size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
95 <<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>>
97 = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
98 init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
100 ghc1_re = pre GHC 4.02
101 ghc2_re = GHC 4.02 (includes "xxM in use")
102 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
105 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>>"
107 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>>"
109 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>>"
111 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>>"
113 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
115 wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
117 out_of_heap = mkRegex "^\\+ Heap exhausted;$"
119 out_of_stack = mkRegex "^\\+ Stack space overflow:"
121 parse_log :: String -> ResultTable
123 = combine_results -- collate information
125 . map process_chunk -- get information from each chunk
126 . tail -- first chunk is junk
127 . chunk_log [] [] -- break at banner lines
130 combine_results :: [(String,Results)] -> FiniteMap String Results
131 combine_results = foldr f emptyFM
133 f (prog,results) fm = addToFM_C combine2Results fm prog results
137 Results{ compile_time = ct1, link_time = lt1,
139 run_time = rt1, mut_time = mt1,
140 instrs = is1, mem_reads = mr1, mem_writes = mw1,
142 gc_time = gt1, gc_work = gw1,
143 binary_size = bs1, allocs = al1,
144 run_status = rs1, compile_status = cs1 }
145 Results{ compile_time = ct2, link_time = lt2,
147 run_time = rt2, mut_time = mt2,
148 instrs = is2, mem_reads = mr2, mem_writes = mw2,
150 gc_time = gt2, gc_work = gw2,
151 binary_size = bs2, allocs = al2,
152 run_status = rs2, compile_status = cs2 }
153 = Results{ compile_time = plusFM_C const ct1 ct2,
154 module_size = plusFM_C const ms1 ms2,
155 link_time = combMaybes lt1 lt2,
156 run_time = rt1 ++ rt2,
157 mut_time = mt1 ++ mt2,
158 instrs = combMaybes is1 is2,
159 mem_reads = combMaybes mr1 mr2,
160 mem_writes = combMaybes mw1 mw2,
161 cache_misses = combMaybes cm1 cm2,
162 gc_time = gt1 ++ gt2,
163 gc_work = combMaybes gw1 gw2,
164 binary_size = combMaybes bs1 bs2,
165 allocs = combMaybes al1 al2,
166 run_status = combStatus rs1 rs2,
167 compile_status = combStatus cs1 cs2 }
169 combMaybes m1 m2 = case maybeToList m1 ++ maybeToList m2 of
173 combStatus NotDone x = x
174 combStatus x NotDone = x
177 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
178 chunk_log header chunk [] = [(header,chunk)]
179 chunk_log header chunk (l:ls) =
180 case matchRegex banner_re l of
181 Nothing -> chunk_log header (l:chunk) ls
182 Just stuff -> (header,chunk) : chunk_log stuff [] ls
184 process_chunk :: ([String],[String]) -> [(String,Results)]
185 process_chunk (prog : what : mod : _, chk) =
187 "time to compile" -> parse_compile_time prog mod chk
188 "time to run" -> parse_run_time prog (reverse chk) emptyResults NotDone
189 "time to link" -> parse_link_time prog chk
190 "size of" -> parse_size prog mod chk
191 _ -> error ("process_chunk: "++what)
193 parse_compile_time prog mod [] = []
194 parse_compile_time prog mod (l:ls) =
195 case matchRegex time_re l of {
196 Just (real:user:system:_) ->
197 let ct = addToFM emptyFM mod (read user)
199 [(prog,emptyResults{compile_time = ct})];
202 case matchRegex time_gnu17_re l of {
203 Just (user:system:elapsed:_) ->
204 let ct = addToFM emptyFM mod (read user)
206 [(prog,emptyResults{compile_time = ct})];
209 case matchRegex ghc1_re l of {
210 Just (allocs:_:_:_:_:init:_:mut:_:gc:_) ->
214 time = (read init + read_mut + read_gc) :: Float
215 ct = addToFM emptyFM mod time
217 [(prog,emptyResults{compile_time = ct})];
220 case matchRegex ghc2_re l of {
221 Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
225 time = (read init + read_mut + read_gc) :: Float
226 ct = addToFM emptyFM mod time
228 [(prog,emptyResults{compile_time = ct})];
231 case matchRegex ghc3_re l of {
232 Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_) ->
236 time = (read init + read_mut + read_gc) :: Float
237 ct = addToFM emptyFM mod time
239 [(prog,emptyResults{compile_time = ct})];
242 case matchRegex ghc4_re l of {
243 Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_:_:_:_) ->
247 time = (read init + read_mut + read_gc) :: Float
248 ct = addToFM emptyFM mod time
250 [(prog,emptyResults{compile_time = ct})];
253 parse_compile_time prog mod ls
256 parse_link_time prog [] = []
257 parse_link_time prog (l:ls) =
258 case matchRegex time_re l of {
259 Just (real:user:system:_) ->
260 [(prog,emptyResults{link_time = Just (read user)})];
263 case matchRegex time_gnu17_re l of {
264 Just (user:system:elapsed:_) ->
265 [(prog,emptyResults{link_time = Just (read user)})];
268 parse_link_time prog ls
272 -- There might be multiple runs of the program, so we have to collect up
273 -- all the results. Variable results like runtimes are aggregated into
274 -- a list, whereas the non-variable aspects are just kept singly.
275 parse_run_time prog [] res NotDone = []
276 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
277 parse_run_time prog (l:ls) res ex =
278 case matchRegex ghc1_re l of {
279 Just (allocs:_:_:_:_:init:_:mut:_:gc:_) ->
280 got_run_result allocs init mut gc Nothing
281 Nothing Nothing Nothing Nothing;
284 case matchRegex ghc2_re l of {
285 Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
286 got_run_result allocs init mut gc Nothing
287 Nothing Nothing Nothing Nothing;
291 case matchRegex ghc3_re l of {
292 Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_) ->
293 got_run_result allocs init mut gc (Just (read gc_work))
294 Nothing Nothing Nothing Nothing;
298 case matchRegex ghc4_re l of {
299 Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses:_) ->
300 got_run_result allocs init mut gc (Just (read gc_work))
301 (Just (read is)) (Just (read mem_rs))
302 (Just (read mem_ws)) (Just (read cache_misses));
306 case matchRegex wrong_output l of {
308 parse_run_time prog ls res (combineRunResult WrongStdout ex);
310 parse_run_time prog ls res (combineRunResult WrongStderr ex);
313 case matchRegex wrong_exit_status l of {
314 Just (wanted:got:_) ->
315 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
318 case matchRegex out_of_heap l of {
320 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
323 case matchRegex out_of_stack l of {
325 parse_run_time prog ls res (combineRunResult OutOfStack ex);
327 parse_run_time prog ls res ex;
331 got_run_result allocs init mut gc gc_work instrs mem_rs mem_ws cache_misses
332 = -- trace ("got_run_result: " ++ init ++ ", " ++ mut ++ ", " ++ gc) $
336 time = (read init + read_mut + read_gc) :: Float
337 res' = combine2Results res
338 emptyResults{ run_time = [time],
339 mut_time = [read_mut],
342 allocs = Just (read allocs),
346 cache_misses = cache_misses,
350 parse_run_time prog ls res' Success
353 combineRunResult OutOfHeap _ = OutOfHeap
354 combineRunResult _ OutOfHeap = OutOfHeap
355 combineRunResult OutOfStack _ = OutOfStack
356 combineRunResult _ OutOfStack = OutOfStack
357 combineRunResult (Exit e) _ = Exit e
358 combineRunResult _ (Exit e) = Exit e
359 combineRunResult exit _ = exit
361 parse_size prog mod [] = []
362 parse_size prog mod (l:ls) =
363 case matchRegex size_re l of
364 Nothing -> parse_size prog mod ls
365 Just (text:datas:bss:_)
367 [(prog,emptyResults{binary_size =
368 Just (read text + read datas),
369 compile_status = Success})]
371 let ms = addToFM emptyFM mod (read text + read datas)
373 [(prog,emptyResults{module_size = ms})]