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 gc_elapsed_time :: [Float],
44 allocs :: Maybe Integer,
46 compile_status :: Status
49 emptyResults :: Results
50 emptyResults = Results {
51 compile_time = Map.empty,
52 module_size = Map.empty,
53 binary_size = Nothing,
60 cache_misses = Nothing,
65 compile_status = NotDone,
69 -----------------------------------------------------------------------------
75 ==nofib== awards: size of QSort.o follows...
76 ==nofib== banner: size of banner follows...
77 ==nofib== awards: time to link awards follows...
78 ==nofib== awards: time to run awards follows...
79 ==nofib== boyer2: time to compile Checker follows...
82 -- NB. the hyphen must come last (or first) inside [...] to stand for itself.
84 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"
87 This regexp for the output of "time" works on FreeBSD, other versions
88 of "time" will need different regexps.
91 time_re :: String -> Maybe (Float, Float, Float)
92 time_re s = case matchRegex re s of
93 Just [real, user, system] ->
94 Just (read real, read user, read system)
95 Just _ -> error "time_re: Can't happen"
97 where re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$"
99 time_gnu17_re :: String -> Maybe (Float, Float, String)
100 time_gnu17_re s = case matchRegex re s of
101 Just [user, system, elapsed] ->
102 Just (read user, read system, elapsed)
103 Just _ -> error "time_gnu17_re: Can't happen"
105 where re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed"
106 -- /usr/bin/time --version reports: GNU time 1.7
107 -- notice the order is different, and the elapsed time
110 size_re :: String -> Maybe (Int, Int, Int)
111 size_re s = case matchRegex re s of
112 Just [text, datas, bss] ->
113 Just (read text, read datas, read bss)
114 Just _ -> error "size_re: Can't happen"
116 where re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)"
119 <<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>>
121 = (bytes, gcs, avg_resid, max_resid, samples, gc_work,
122 init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed)
124 ghc1_re = pre GHC 4.02
125 ghc2_re = GHC 4.02 (includes "xxM in use")
126 ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
129 ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
130 ghc1_re s = case matchRegex re s of
131 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
132 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)
133 Just _ -> error "ghc1_re: Can't happen"
135 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>>"
137 ghc2_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
138 ghc2_re s = case matchRegex re s of
139 Just [allocations, gcs, avg_residency, max_residency, samples, in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
140 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)
141 Just _ -> error "ghc2_re: Can't happen"
143 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>>"
145 ghc3_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
146 ghc3_re s = case matchRegex re s of
147 Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] ->
148 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)
149 Just _ -> error "ghc3_re: Can't happen"
151 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>>"
153 ghc4_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float, Integer, Integer, Integer, Integer)
154 ghc4_re s = case matchRegex re s of
155 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] ->
156 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)
157 Just _ -> error "ghc4_re: Can't happen"
159 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>>"
161 wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex
162 wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)"
163 wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
164 out_of_heap = mkRegex "^\\+ Heap exhausted;$"
165 out_of_stack = mkRegex "^\\+ Stack space overflow:"
167 parse_log :: String -> ResultTable
169 = combine_results -- collate information
171 . map process_chunk -- get information from each chunk
172 . tail -- first chunk is junk
173 . chunk_log [] [] -- break at banner lines
176 combine_results :: [(String,Results)] -> Map String Results
177 combine_results = foldr f Map.empty
179 f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm
181 combine2Results :: Results -> Results -> Results
183 Results{ compile_time = ct1, link_time = lt1,
185 run_time = rt1, mut_time = mt1,
186 instrs = is1, mem_reads = mr1, mem_writes = mw1,
188 gc_time = gt1, gc_elapsed_time = ge1, gc_work = gw1,
189 binary_size = bs1, allocs = al1,
190 run_status = rs1, compile_status = cs1 }
191 Results{ compile_time = ct2, link_time = lt2,
193 run_time = rt2, mut_time = mt2,
194 instrs = is2, mem_reads = mr2, mem_writes = mw2,
196 gc_time = gt2, gc_elapsed_time = ge2, gc_work = gw2,
197 binary_size = bs2, allocs = al2,
198 run_status = rs2, compile_status = cs2 }
199 = Results{ compile_time = Map.unionWith (flip const) ct1 ct2,
200 module_size = Map.unionWith (flip const) ms1 ms2,
201 link_time = lt1 `mplus` lt2,
202 run_time = rt1 ++ rt2,
203 mut_time = mt1 ++ mt2,
204 instrs = is1 `mplus` is2,
205 mem_reads = mr1 `mplus` mr2,
206 mem_writes = mw1 `mplus` mw2,
207 cache_misses = cm1 `mplus` cm2,
208 gc_time = gt1 ++ gt2,
209 gc_elapsed_time= ge1 ++ ge2,
210 gc_work = gw1 `mplus` gw2,
211 binary_size = bs1 `mplus` bs2,
212 allocs = al1 `mplus` al2,
213 run_status = combStatus rs1 rs2,
214 compile_status = combStatus cs1 cs2 }
216 combStatus :: Status -> Status -> Status
217 combStatus NotDone y = y
218 combStatus x NotDone = x
221 chunk_log :: [String] -> [String] -> [String] -> [([String],[String])]
222 chunk_log header chunk [] = [(header,chunk)]
223 chunk_log header chunk (l:ls) =
224 case matchRegex banner_re l of
225 Nothing -> chunk_log header (l:chunk) ls
226 Just stuff -> (header,chunk) : chunk_log stuff [] ls
228 process_chunk :: ([String],[String]) -> [(String,Results)]
229 process_chunk (progName : what : modName : _, chk) =
231 "time to compile" -> parse_compile_time progName modName chk
232 "time to run" -> parse_run_time progName (reverse chk) emptyResults NotDone
233 "time to compile & run" -> parse_compile_time progName modName chk
234 ++ parse_run_time progName (reverse chk) emptyResults NotDone
235 "time to link" -> parse_link_time progName chk
236 "size of" -> parse_size progName modName chk
237 _ -> error ("process_chunk: "++what)
238 process_chunk _ = error "process_chunk: Can't happen"
240 parse_compile_time :: String -> String -> [String] -> [(String, Results)]
241 parse_compile_time _ _ [] = []
242 parse_compile_time progName modName (l:ls) =
244 Just (_real, user, _system) ->
245 let ct = Map.singleton modName user
247 [(progName, emptyResults{compile_time = ct})];
250 case time_gnu17_re l of {
251 Just (user, _system, _elapsed) ->
252 let ct = Map.singleton modName user
254 [(progName, emptyResults{compile_time = ct})];
258 Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
260 time = (initialisation + mut + gc) :: Float
261 ct = Map.singleton modName time
263 [(progName, emptyResults{compile_time = ct})];
267 Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
268 let ct = Map.singleton modName (initialisation + mut + gc)
270 [(progName, emptyResults{compile_time = ct})];
274 Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _) ->
275 let ct = Map.singleton modName (initialisation + mut + gc)
277 [(progName, emptyResults{compile_time = ct})];
281 Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) ->
282 let ct = Map.singleton modName (initialisation + mut + gc)
284 [(progName, emptyResults{compile_time = ct})];
287 parse_compile_time progName modName ls
290 parse_link_time :: String -> [String] -> [(String, Results)]
291 parse_link_time _ [] = []
292 parse_link_time prog (l:ls) =
294 Just (_real, user, _system) ->
295 [(prog,emptyResults{link_time = Just user})];
298 case time_gnu17_re l of {
299 Just (user, _system, _elapsed) ->
300 [(prog,emptyResults{link_time = Just user})];
303 parse_link_time prog ls
307 -- There might be multiple runs of the program, so we have to collect up
308 -- all the results. Variable results like runtimes are aggregated into
309 -- a list, whereas the non-variable aspects are just kept singly.
310 parse_run_time :: String -> [String] -> Results -> Status
311 -> [(String, Results)]
312 parse_run_time _ [] _ NotDone = []
313 parse_run_time prog [] res ex = [(prog, res{run_status=ex})]
314 parse_run_time prog (l:ls) res ex =
316 Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, gc_elapsed) ->
317 got_run_result allocations initialisation mut gc gc_elapsed
318 Nothing Nothing Nothing Nothing Nothing;
322 Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, gc_elapsed) ->
323 got_run_result allocations initialisation mut gc gc_elapsed
324 Nothing Nothing Nothing Nothing Nothing;
329 Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, _, gc, gc_elapsed) ->
330 got_run_result allocations initialisation mut gc gc_elapsed
331 (Just gc_work') Nothing Nothing Nothing Nothing;
336 Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, _, gc, gc_elapsed, is, mem_rs, mem_ws, cache_misses') ->
337 got_run_result allocations initialisation mut gc gc_elapsed
338 (Just gc_work') (Just is) (Just mem_rs)
339 (Just mem_ws) (Just cache_misses');
343 case matchRegex wrong_output l of {
345 parse_run_time prog ls res (combineRunResult WrongStdout ex);
347 parse_run_time prog ls res (combineRunResult WrongStderr ex);
348 Just _ -> error "wrong_output: Can't happen";
351 case matchRegex wrong_exit_status l of {
352 Just [_wanted, got] ->
353 parse_run_time prog ls res (combineRunResult (Exit (read got)) ex);
354 Just _ -> error "wrong_exit_status: Can't happen";
357 case matchRegex out_of_heap l of {
359 parse_run_time prog ls res (combineRunResult OutOfHeap ex);
362 case matchRegex out_of_stack l of {
364 parse_run_time prog ls res (combineRunResult OutOfStack ex);
366 parse_run_time prog ls res ex;
370 got_run_result allocations initialisation mut gc gc_elapsed gc_work' instrs' mem_rs mem_ws cache_misses'
371 = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
373 time = initialisation + mut + gc
374 res' = combine2Results res
375 emptyResults{ run_time = [time],
378 gc_elapsed_time = [gc_elapsed],
380 allocs = Just allocations,
384 cache_misses = cache_misses',
388 parse_run_time prog ls res' Success
390 combineRunResult :: Status -> Status -> Status
391 combineRunResult OutOfHeap _ = OutOfHeap
392 combineRunResult _ OutOfHeap = OutOfHeap
393 combineRunResult OutOfStack _ = OutOfStack
394 combineRunResult _ OutOfStack = OutOfStack
395 combineRunResult (Exit e) _ = Exit e
396 combineRunResult _ (Exit e) = Exit e
397 combineRunResult exit _ = exit
399 parse_size :: String -> String -> [String] -> [(String, Results)]
400 parse_size _ _ [] = []
401 parse_size progName modName (l:ls) =
403 Nothing -> parse_size progName modName ls
404 Just (text, datas, _bss)
405 | progName == modName ->
406 [(progName,emptyResults{binary_size =
408 compile_status = Success})]
410 let ms = Map.singleton modName (text + datas)
412 [(progName,emptyResults{module_size = ms})]