1 -----------------------------------------------------------------------------
2 -- $Id: Slurp.hs,v 1.3 2002/02/28 18:50:42 keithw Exp $
4 -- (c) Simon Marlow 1997-1999
5 -----------------------------------------------------------------------------
7 module Slurp (Status(..), Results(..), ResultTable(..), parse_log) where
14 -----------------------------------------------------------------------------
15 -- This is the structure into which we collect our results:
17 type ResultTable = FiniteMap String Results
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,
42 compile_status :: Status
45 emptyResults = Results {
46 compile_time = emptyFM,
47 module_size = emptyFM,
48 binary_size = Nothing,
58 compile_status = NotDone,
62 -----------------------------------------------------------------------------
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...
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"
78 This regexp for the output of "time" works on FreeBSD, other versions
79 of "time" will need different regexps.
82 time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
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
88 size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
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>>
93 = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
94 init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
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")
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>>"
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>>"
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>>"
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>>"
109 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
111 wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
113 out_of_heap = mkRegex "^\\+ Heap exhausted;$"
115 out_of_stack = mkRegex "^\\+ Stack space overflow:"
117 parse_log :: String -> ResultTable
119 = combine_results -- collate information
121 . map process_chunk -- get information from each chunk
122 . tail -- first chunk is junk
123 . chunk_log [] [] -- break at banner lines
126 combine_results :: [(String,Results)] -> FiniteMap String Results
127 combine_results = foldr f emptyFM
129 f (prog,results) fm = addToFM_C comb fm prog results
130 comb Results{ compile_time = ct1, link_time = lt1,
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,
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 }
159 combMaybes m1 m2 = case maybeToList m1 ++ maybeToList m2 of
163 combStatus NotDone x = x
164 combStatus x NotDone = x
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
174 process_chunk :: ([String],[String]) -> [(String,Results)]
175 process_chunk (prog : what : mod : _, chk) =
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)
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)
189 [(prog,emptyResults{compile_time = ct})];
192 case matchRegex time_gnu17_re l of {
193 Just (user:system:elapsed:_) ->
194 let ct = addToFM emptyFM mod (read user)
196 [(prog,emptyResults{compile_time = ct})];
199 case matchRegex ghc1_re l of {
200 Just (allocs:_:_:_:_:init:_:mut:_:gc:_) ->
204 time = (read init + read_mut + read_gc) :: Float
205 ct = addToFM emptyFM mod time
207 [(prog,emptyResults{compile_time = ct})];
210 case matchRegex ghc2_re l of {
211 Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
215 time = (read init + read_mut + read_gc) :: Float
216 ct = addToFM emptyFM mod time
218 [(prog,emptyResults{compile_time = ct})];
221 case matchRegex ghc3_re l of {
222 Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_) ->
226 time = (read init + read_mut + read_gc) :: Float
227 ct = addToFM emptyFM mod time
229 [(prog,emptyResults{compile_time = ct})];
232 case matchRegex ghc4_re l of {
233 Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_:_:_:_) ->
237 time = (read init + read_mut + read_gc) :: Float
238 ct = addToFM emptyFM mod time
240 [(prog,emptyResults{compile_time = ct})];
243 parse_compile_time prog mod ls
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)})];
253 case matchRegex time_gnu17_re l of {
254 Just (user:system:elapsed:_) ->
255 [(prog,emptyResults{link_time = Just (read user)})];
258 parse_link_time prog ls
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:_) ->
269 time = (read init + read_mut + read_gc) :: Float
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 })];
278 case matchRegex ghc2_re l of {
279 Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) ->
283 time = (read init + read_mut + read_gc) :: Float
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 })];
292 case matchRegex ghc3_re l of {
293 Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_) ->
297 read_gc_work = read gc_work
298 time = (read init + read_mut + read_gc) :: Float
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 })];
308 case matchRegex ghc4_re l of {
309 Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:_) ->
313 read_gc_work = read gc_work
314 time = (read init + read_mut + read_gc) :: Float
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 })];
327 case matchRegex wrong_output l of {
329 parse_run_time prog ls (combineRunResult WrongStdout ex);
331 parse_run_time prog ls (combineRunResult WrongStderr ex);
334 case matchRegex wrong_exit_status l of {
335 Just (wanted:got:_) ->
336 parse_run_time prog ls (combineRunResult (Exit (read got)) ex);
339 case matchRegex out_of_heap l of {
341 parse_run_time prog ls (combineRunResult OutOfHeap ex);
344 case matchRegex out_of_stack l of {
346 parse_run_time prog ls (combineRunResult OutOfStack ex);
348 parse_run_time prog ls ex;
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
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:_)
366 [(prog,emptyResults{binary_size =
367 Just (read text + read datas),
368 compile_status = Success})]
370 let ms = addToFM emptyFM mod (read text + read datas)
372 [(prog,emptyResults{module_size = ms})]