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 instrs :: Maybe Integer,
38 mem_reads :: Maybe Integer,
39 mem_writes :: Maybe Integer,
40 cache_misses :: Maybe Integer,
41 gc_work :: Maybe Integer,
43 allocs :: Maybe Integer,
45 compile_status :: Status
48 emptyResults :: Results
49 emptyResults = Results {
50 compile_time = Map.empty,
51 module_size = Map.empty,
52 binary_size = Nothing,
59 cache_misses = Nothing,
63 compile_status = NotDone,
67 -----------------------------------------------------------------------------
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...
80 -- NB. the hyphen must come last (or first) inside [...] to stand for itself.
82 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"
85 This regexp for the output of "time" works on FreeBSD, other versions
86 of "time" will need different regexps.
90 time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
92 time_gnu17_re :: Regex
93 time_gnu17_re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
94 -- /usr/bin/time --version reports: GNU time 1.7
95 -- notice the order is different, and the elapsed time is [hh:]mm:ss.s
98 size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
101 <<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>>
103 = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
104 init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
106 ghc1_re = pre GHC 4.02
107 ghc2_re = GHC 4.02 (includes "xxM in use")
108 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
111 ghc1_re, ghc2_re, ghc3_re, ghc4_re :: Regex
112 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>>"
114 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>>"
116 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>>"
118 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>>"
120 wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex
121 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
122 wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
123 out_of_heap = mkRegex "^\\+ Heap exhausted;$"
124 out_of_stack = mkRegex "^\\+ Stack space overflow:"
126 parse_log :: String -> ResultTable
128 = combine_results -- collate information
130 . map process_chunk -- get information from each chunk
131 . tail -- first chunk is junk
132 . chunk_log [] [] -- break at banner lines
135 combine_results :: [(String,Results)] -> Map String Results
136 combine_results = foldr f Map.empty
138 f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm
140 combine2Results :: Results -> Results -> Results
142 Results{ compile_time = ct1, link_time = lt1,
144 run_time = rt1, mut_time = mt1,
145 instrs = is1, mem_reads = mr1, mem_writes = mw1,
147 gc_time = gt1, gc_work = gw1,
148 binary_size = bs1, allocs = al1,
149 run_status = rs1, compile_status = cs1 }
150 Results{ compile_time = ct2, link_time = lt2,
152 run_time = rt2, mut_time = mt2,
153 instrs = is2, mem_reads = mr2, mem_writes = mw2,
155 gc_time = gt2, gc_work = gw2,
156 binary_size = bs2, allocs = al2,
157 run_status = rs2, compile_status = cs2 }
158 = Results{ compile_time = Map.unionWith (flip const) ct1 ct2,
159 module_size = Map.unionWith (flip const) ms1 ms2,
160 link_time = lt1 `mplus` lt2,
161 run_time = rt1 ++ rt2,
162 mut_time = mt1 ++ mt2,
163 instrs = is1 `mplus` is2,
164 mem_reads = mr1 `mplus` mr2,
165 mem_writes = mw1 `mplus` mw2,
166 cache_misses = cm1 `mplus` cm2,
167 gc_time = gt1 ++ gt2,
168 gc_work = gw1 `mplus` gw2,
169 binary_size = bs1 `mplus` bs2,
170 allocs = al1 `mplus` al2,
171 run_status = combStatus rs1 rs2,
172 compile_status = combStatus cs1 cs2 }
174 combStatus :: Status -> Status -> Status
175 combStatus NotDone y = y
176 combStatus x NotDone = x
179 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
180 chunk_log header chunk [] = [(header,chunk)]
181 chunk_log header chunk (l:ls) =
182 case matchRegex banner_re l of
183 Nothing -> chunk_log header (l:chunk) ls
184 Just stuff -> (header,chunk) : chunk_log stuff [] ls
186 process_chunk :: ([String],[String]) -> [(String,Results)]
187 process_chunk (progName : what : modName : _, chk) =
189 "time to compile" -> parse_compile_time progName modName chk
190 "time to run" -> parse_run_time progName (reverse chk) emptyResults NotDone
191 "time to link" -> parse_link_time progName chk
192 "size of" -> parse_size progName modName chk
193 _ -> error ("process_chunk: "++what)
194 process_chunk _ = error "process_chunk: Can't happen"
196 parse_compile_time :: String -> String -> [String] -> [(String, Results)]
197 parse_compile_time _ _ [] = []
198 parse_compile_time progName modName (l:ls) =
199 case matchRegex time_re l of {
200 Just (_real:user:_system:_) ->
201 let ct = Map.singleton modName (read user)
203 [(progName, emptyResults{compile_time = ct})];
206 case matchRegex time_gnu17_re l of {
207 Just (user:_system:_elapsed:_) ->
208 let ct = Map.singleton modName (read user)
210 [(progName, emptyResults{compile_time = ct})];
213 case matchRegex ghc1_re l of {
214 Just (_allocations:_:_:_:_:initialisation:_:mut:_:gc:_) ->
218 time = (read initialisation + read_mut + read_gc) :: Float
219 ct = Map.singleton modName time
221 [(progName, emptyResults{compile_time = ct})];
224 case matchRegex ghc2_re l of {
225 Just (_allocations:_:_:_:_:_:initialisation:_:mut:_:gc:_) ->
229 time = (read initialisation + read_mut + read_gc) :: Float
230 ct = Map.singleton modName time
232 [(progName, emptyResults{compile_time = ct})];
235 case matchRegex ghc3_re l of {
236 Just (_allocations:_:_:_:_:_:_:initialisation:_:mut:_:gc:_) ->
240 time = (read initialisation + read_mut + read_gc) :: Float
241 ct = Map.singleton modName time
243 [(progName, emptyResults{compile_time = ct})];
246 case matchRegex ghc4_re l of {
247 Just (_allocations:_:_:_:_:_:_:initialisation:_:mut:_:gc:_:_:_:_) ->
251 time = (read initialisation + read_mut + read_gc) :: Float
252 ct = Map.singleton modName time
254 [(progName, emptyResults{compile_time = ct})];
257 parse_compile_time progName modName ls
260 parse_link_time :: String -> [String] -> [(String, Results)]
261 parse_link_time _ [] = []
262 parse_link_time prog (l:ls) =
263 case matchRegex time_re l of {
264 Just (_real:user:_system:_) ->
265 [(prog,emptyResults{link_time = Just (read user)})];
268 case matchRegex time_gnu17_re l of {
269 Just (user:_system:_elapsed:_) ->
270 [(prog,emptyResults{link_time = Just (read user)})];
273 parse_link_time prog ls
277 -- There might be multiple runs of the program, so we have to collect up
278 -- all the results. Variable results like runtimes are aggregated into
279 -- a list, whereas the non-variable aspects are just kept singly.
280 parse_run_time :: String -> [String] -> Results -> Status
281 -> [(String, Results)]
282 parse_run_time _ [] _ NotDone = []
283 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
284 parse_run_time prog (l:ls) res ex =
285 case matchRegex ghc1_re l of {
286 Just (allocations:_:_:_:_:initialisation:_:mut:_:gc:_) ->
287 got_run_result allocations initialisation mut gc Nothing
288 Nothing Nothing Nothing Nothing;
291 case matchRegex ghc2_re l of {
292 Just (allocations:_:_:_:_:_:initialisation:_:mut:_:gc:_) ->
293 got_run_result allocations initialisation mut gc Nothing
294 Nothing Nothing Nothing Nothing;
298 case matchRegex ghc3_re l of {
299 Just (allocations:_:_:_:_:gc_work':_:initialisation:_:mut:_:gc:_) ->
300 got_run_result allocations initialisation mut gc (Just (read gc_work'))
301 Nothing Nothing Nothing Nothing;
305 case matchRegex ghc4_re l of {
306 Just (allocations:_:_:_:_:gc_work':_:initialisation:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses':_) ->
307 got_run_result allocations initialisation mut gc (Just (read gc_work'))
308 (Just (read is)) (Just (read mem_rs))
309 (Just (read mem_ws)) (Just (read cache_misses'));
313 case matchRegex wrong_output l of {
315 parse_run_time prog ls res (combineRunResult WrongStdout ex);
317 parse_run_time prog ls res (combineRunResult WrongStderr ex);
320 case matchRegex wrong_exit_status l of {
321 Just (_wanted:got:_) ->
322 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
325 case matchRegex out_of_heap l of {
327 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
330 case matchRegex out_of_stack l of {
332 parse_run_time prog ls res (combineRunResult OutOfStack ex);
334 parse_run_time prog ls res ex;
338 got_run_result allocations initialisation mut gc gc_work' instrs' mem_rs mem_ws cache_misses'
339 = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
343 time = (read initialisation + read_mut + read_gc) :: Float
344 res' = combine2Results res
345 emptyResults{ run_time = [time],
346 mut_time = [read_mut],
349 allocs = Just (read allocations),
353 cache_misses = cache_misses',
357 parse_run_time prog ls res' Success
359 combineRunResult :: Status -> Status -> Status
360 combineRunResult OutOfHeap _ = OutOfHeap
361 combineRunResult _ OutOfHeap = OutOfHeap
362 combineRunResult OutOfStack _ = OutOfStack
363 combineRunResult _ OutOfStack = OutOfStack
364 combineRunResult (Exit e) _ = Exit e
365 combineRunResult _ (Exit e) = Exit e
366 combineRunResult exit _ = exit
368 parse_size :: String -> String -> [String] -> [(String, Results)]
369 parse_size _ _ [] = []
370 parse_size progName modName (l:ls) =
371 case matchRegex size_re l of
372 Nothing -> parse_size progName modName ls
373 Just (text:datas:_bss:_)
374 | progName == modName ->
375 [(progName,emptyResults{binary_size =
376 Just (read text + read datas),
377 compile_status = Success})]
379 let ms = Map.singleton modName (read text + read datas)
381 [(progName,emptyResults{module_size = ms})]