X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fnofib-analyse%2FSlurp.hs;h=6d3183e0babcf9ee6f0ddd36d8c0d40c03bf2655;hb=c004ec62b41aa2137b5b5e298ca562609b0de92e;hp=f775baee4fc0e165f4a47286ab96242e955bbd77;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/utils/nofib-analyse/Slurp.hs b/utils/nofib-analyse/Slurp.hs index f775bae..6d3183e 100644 --- a/utils/nofib-analyse/Slurp.hs +++ b/utils/nofib-analyse/Slurp.hs @@ -4,63 +4,65 @@ -- ----------------------------------------------------------------------------- -module Slurp (Status(..), Results(..), ResultTable(..), parse_log) where +module Slurp (Status(..), Results(..), ResultTable, parse_log) where -import CmdLine -import Data.FiniteMap -import RegexString +import Control.Monad +import qualified Data.Map as Map +import Data.Map (Map) +import Text.Regex import Data.Maybe -- import Debug.Trace ----------------------------------------------------------------------------- -- This is the structure into which we collect our results: -type ResultTable = FiniteMap String Results +type ResultTable = Map String Results data Status - = NotDone - | Success - | OutOfHeap - | OutOfStack - | Exit Int - | WrongStdout - | WrongStderr - -data Results = Results { - compile_time :: FiniteMap String Float, - module_size :: FiniteMap String Int, - binary_size :: Maybe Int, - link_time :: Maybe Float, - run_time :: [Float], - mut_time :: [Float], - instrs :: Maybe Integer, - mem_reads :: Maybe Integer, - mem_writes :: Maybe Integer, - cache_misses :: Maybe Integer, - gc_work :: Maybe Integer, - gc_time :: [Float], - allocs :: Maybe Integer, - run_status :: Status, - compile_status :: Status - } - -emptyResults = Results { - compile_time = emptyFM, - module_size = emptyFM, - binary_size = Nothing, - link_time = Nothing, - run_time = [], - mut_time = [], - instrs = Nothing, - mem_reads = Nothing, - mem_writes = Nothing, - cache_misses = Nothing, - gc_time = [], - gc_work = Nothing, - allocs = Nothing, - compile_status = NotDone, - run_status = NotDone - } + = NotDone + | Success + | OutOfHeap + | OutOfStack + | Exit Int + | WrongStdout + | WrongStderr + +data Results = Results { + compile_time :: Map String Float, + module_size :: Map String Int, + binary_size :: Maybe Int, + link_time :: Maybe Float, + run_time :: [Float], + mut_time :: [Float], + instrs :: Maybe Integer, + mem_reads :: Maybe Integer, + mem_writes :: Maybe Integer, + cache_misses :: Maybe Integer, + gc_work :: Maybe Integer, + gc_time :: [Float], + allocs :: Maybe Integer, + run_status :: Status, + compile_status :: Status + } + +emptyResults :: Results +emptyResults = Results { + compile_time = Map.empty, + module_size = Map.empty, + binary_size = Nothing, + link_time = Nothing, + run_time = [], + mut_time = [], + instrs = Nothing, + mem_reads = Nothing, + mem_writes = Nothing, + cache_misses = Nothing, + gc_time = [], + gc_work = Nothing, + allocs = Nothing, + compile_status = NotDone, + run_status = NotDone + } ----------------------------------------------------------------------------- -- Parse the log file @@ -75,194 +77,225 @@ Various banner lines: ==nofib== boyer2: time to compile Checker follows... -} -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" +-- NB. the hyphen must come last (or first) inside [...] to stand for itself. +banner_re :: Regex +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" {- This regexp for the output of "time" works on FreeBSD, other versions of "time" will need different regexps. -} -time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$" - -time_gnu17_re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed" - -- /usr/bin/time --version reports: GNU time 1.7 - -- notice the order is different, and the elapsed time is [hh:]mm:ss.s - -size_re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)" +time_re :: String -> Maybe (Float, Float, Float) +time_re s = case matchRegex re s of + Just [real, user, system] -> + Just (read real, read user, read system) + Just _ -> error "time_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$" + +time_gnu17_re :: String -> Maybe (Float, Float, String) +time_gnu17_re s = case matchRegex re s of + Just [user, system, elapsed] -> + Just (read user, read system, elapsed) + Just _ -> error "time_gnu17_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^[ \t]*([0-9.]+)user[ \t]+([0-9.]+)system[ \t]+([0-9.:]+)elapsed" + -- /usr/bin/time --version reports: GNU time 1.7 + -- notice the order is different, and the elapsed time + -- is [hh:]mm:ss.s + +size_re :: String -> Maybe (Int, Int, Int) +size_re s = case matchRegex re s of + Just [text, datas, bss] -> + Just (read text, read datas, read bss) + Just _ -> error "size_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)" {- <> - = (bytes, gcs, avg_resid, max_resid, samples, gc_work, - init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) + = (bytes, gcs, avg_resid, max_resid, samples, gc_work, + init, init_elapsed, mut, mut_elapsed, gc, gc_elapsed) ghc1_re = pre GHC 4.02 ghc2_re = GHC 4.02 (includes "xxM in use") ghc3_re = GHC 4.03 (includes "xxxx bytes GC work") -} -ghc1_re = mkRegex "^<>" - -ghc2_re = mkRegex "^<>" - -ghc3_re = mkRegex "^<>" - -ghc4_re = mkRegex "^<>" - +ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float) +ghc1_re s = case matchRegex re s of + Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] -> + 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) + Just _ -> error "ghc1_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^<>" + +ghc2_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float) +ghc2_re s = case matchRegex re s of + Just [allocations, gcs, avg_residency, max_residency, samples, in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] -> + 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) + Just _ -> error "ghc2_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^<>" + +ghc3_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float) +ghc3_re s = case matchRegex re s of + Just [allocations, gcs, avg_residency, max_residency, samples, gc_work', in_use, initialisation, initialisation_elapsed, mut, mut_elapsed, gc, gc_elapsed] -> + 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) + Just _ -> error "ghc3_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^<>" + +ghc4_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float, Integer, Integer, Integer, Integer) +ghc4_re s = case matchRegex re s of + 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] -> + 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) + Just _ -> error "ghc4_re: Can't happen" + Nothing -> Nothing + where re = mkRegex "^<>" + +wrong_exit_status, wrong_output, out_of_heap, out_of_stack :: Regex wrong_exit_status = mkRegex "^\\**[ \t]*expected exit status ([0-9]+) not seen ; got ([0-9]+)" - -wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$" - -out_of_heap = mkRegex "^\\+ Heap exhausted;$" - -out_of_stack = mkRegex "^\\+ Stack space overflow:" +wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$" +out_of_heap = mkRegex "^\\+ Heap exhausted;$" +out_of_stack = mkRegex "^\\+ Stack space overflow:" parse_log :: String -> ResultTable parse_log - = combine_results -- collate information - . concat - . map process_chunk -- get information from each chunk - . tail -- first chunk is junk - . chunk_log [] [] -- break at banner lines - . lines - -combine_results :: [(String,Results)] -> FiniteMap String Results -combine_results = foldr f emptyFM + = combine_results -- collate information + . concat + . map process_chunk -- get information from each chunk + . tail -- first chunk is junk + . chunk_log [] [] -- break at banner lines + . lines + +combine_results :: [(String,Results)] -> Map String Results +combine_results = foldr f Map.empty where - f (prog,results) fm = addToFM_C combine2Results fm prog results - + f (prog,results) fm = Map.insertWith (flip combine2Results) prog results fm +combine2Results :: Results -> Results -> Results combine2Results - Results{ compile_time = ct1, link_time = lt1, - module_size = ms1, - run_time = rt1, mut_time = mt1, - instrs = is1, mem_reads = mr1, mem_writes = mw1, - cache_misses = cm1, - gc_time = gt1, gc_work = gw1, - binary_size = bs1, allocs = al1, - run_status = rs1, compile_status = cs1 } - Results{ compile_time = ct2, link_time = lt2, - module_size = ms2, - run_time = rt2, mut_time = mt2, - instrs = is2, mem_reads = mr2, mem_writes = mw2, - cache_misses = cm2, - gc_time = gt2, gc_work = gw2, - binary_size = bs2, allocs = al2, - run_status = rs2, compile_status = cs2 } - = Results{ compile_time = plusFM_C const ct1 ct2, - module_size = plusFM_C const ms1 ms2, - link_time = combMaybes lt1 lt2, - run_time = rt1 ++ rt2, - mut_time = mt1 ++ mt2, - instrs = combMaybes is1 is2, - mem_reads = combMaybes mr1 mr2, - mem_writes = combMaybes mw1 mw2, - cache_misses = combMaybes cm1 cm2, - gc_time = gt1 ++ gt2, - gc_work = combMaybes gw1 gw2, - binary_size = combMaybes bs1 bs2, - allocs = combMaybes al1 al2, - run_status = combStatus rs1 rs2, - compile_status = combStatus cs1 cs2 } - -combMaybes m1 m2 = case maybeToList m1 ++ maybeToList m2 of - [] -> Nothing - (x:_) -> Just x - -combStatus NotDone x = x -combStatus x NotDone = x -combStatus x y = x + Results{ compile_time = ct1, link_time = lt1, + module_size = ms1, + run_time = rt1, mut_time = mt1, + instrs = is1, mem_reads = mr1, mem_writes = mw1, + cache_misses = cm1, + gc_time = gt1, gc_work = gw1, + binary_size = bs1, allocs = al1, + run_status = rs1, compile_status = cs1 } + Results{ compile_time = ct2, link_time = lt2, + module_size = ms2, + run_time = rt2, mut_time = mt2, + instrs = is2, mem_reads = mr2, mem_writes = mw2, + cache_misses = cm2, + gc_time = gt2, gc_work = gw2, + binary_size = bs2, allocs = al2, + run_status = rs2, compile_status = cs2 } + = Results{ compile_time = Map.unionWith (flip const) ct1 ct2, + module_size = Map.unionWith (flip const) ms1 ms2, + link_time = lt1 `mplus` lt2, + run_time = rt1 ++ rt2, + mut_time = mt1 ++ mt2, + instrs = is1 `mplus` is2, + mem_reads = mr1 `mplus` mr2, + mem_writes = mw1 `mplus` mw2, + cache_misses = cm1 `mplus` cm2, + gc_time = gt1 ++ gt2, + gc_work = gw1 `mplus` gw2, + binary_size = bs1 `mplus` bs2, + allocs = al1 `mplus` al2, + run_status = combStatus rs1 rs2, + compile_status = combStatus cs1 cs2 } + +combStatus :: Status -> Status -> Status +combStatus NotDone y = y +combStatus x NotDone = x +combStatus x _ = x chunk_log :: [String] -> [String] -> [String] -> [([String],[String])] chunk_log header chunk [] = [(header,chunk)] chunk_log header chunk (l:ls) = - case matchRegex banner_re l of - Nothing -> chunk_log header (l:chunk) ls - Just stuff -> (header,chunk) : chunk_log stuff [] ls + case matchRegex banner_re l of + Nothing -> chunk_log header (l:chunk) ls + Just stuff -> (header,chunk) : chunk_log stuff [] ls process_chunk :: ([String],[String]) -> [(String,Results)] -process_chunk (prog : what : mod : _, chk) = +process_chunk (progName : what : modName : _, chk) = case what of - "time to compile" -> parse_compile_time prog mod chk - "time to run" -> parse_run_time prog (reverse chk) emptyResults NotDone - "time to link" -> parse_link_time prog chk - "size of" -> parse_size prog mod chk - _ -> error ("process_chunk: "++what) - -parse_compile_time prog mod [] = [] -parse_compile_time prog mod (l:ls) = - case matchRegex time_re l of { - Just (real:user:system:_) -> - let ct = addToFM emptyFM mod (read user) - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex time_gnu17_re l of { - Just (user:system:elapsed:_) -> - let ct = addToFM emptyFM mod (read user) - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc1_re l of { - Just (allocs:_:_:_:_:init:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc2_re l of { - Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc3_re l of { - Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - case matchRegex ghc4_re l of { - Just (allocs:_:_:_:_:_:_:init:_:mut:_:gc:_:_:_:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time - in - [(prog,emptyResults{compile_time = ct})]; - Nothing -> - - parse_compile_time prog mod ls - }}}}}} - -parse_link_time prog [] = [] + "time to compile" -> parse_compile_time progName modName chk + "time to run" -> parse_run_time progName (reverse chk) emptyResults NotDone + "time to compile & run" -> parse_compile_time progName modName chk + ++ parse_run_time progName (reverse chk) emptyResults NotDone + "time to link" -> parse_link_time progName chk + "size of" -> parse_size progName modName chk + _ -> error ("process_chunk: "++what) +process_chunk _ = error "process_chunk: Can't happen" + +parse_compile_time :: String -> String -> [String] -> [(String, Results)] +parse_compile_time _ _ [] = [] +parse_compile_time progName modName (l:ls) = + case time_re l of { + Just (_real, user, _system) -> + let ct = Map.singleton modName user + in + [(progName, emptyResults{compile_time = ct})]; + Nothing -> + + case time_gnu17_re l of { + Just (user, _system, _elapsed) -> + let ct = Map.singleton modName user + in + [(progName, emptyResults{compile_time = ct})]; + Nothing -> + + case ghc1_re l of { + Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> + let + time = (initialisation + mut + gc) :: Float + ct = Map.singleton modName time + in + [(progName, emptyResults{compile_time = ct})]; + Nothing -> + + case ghc2_re l of { + Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> + let ct = Map.singleton modName (initialisation + mut + gc) + in + [(progName, emptyResults{compile_time = ct})]; + Nothing -> + + case ghc3_re l of { + Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> + let ct = Map.singleton modName (initialisation + mut + gc) + in + [(progName, emptyResults{compile_time = ct})]; + Nothing -> + + case ghc4_re l of { + Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) -> + let ct = Map.singleton modName (initialisation + mut + gc) + in + [(progName, emptyResults{compile_time = ct})]; + Nothing -> + + parse_compile_time progName modName ls + }}}}}} + +parse_link_time :: String -> [String] -> [(String, Results)] +parse_link_time _ [] = [] parse_link_time prog (l:ls) = - case matchRegex time_re l of { - Just (real:user:system:_) -> - [(prog,emptyResults{link_time = Just (read user)})]; - Nothing -> + case time_re l of { + Just (_real, user, _system) -> + [(prog,emptyResults{link_time = Just user})]; + Nothing -> - case matchRegex time_gnu17_re l of { - Just (user:system:elapsed:_) -> - [(prog,emptyResults{link_time = Just (read user)})]; - Nothing -> + case time_gnu17_re l of { + Just (user, _system, _elapsed) -> + [(prog,emptyResults{link_time = Just user})]; + Nothing -> parse_link_time prog ls }} @@ -271,103 +304,106 @@ parse_link_time prog (l:ls) = -- There might be multiple runs of the program, so we have to collect up -- all the results. Variable results like runtimes are aggregated into -- a list, whereas the non-variable aspects are just kept singly. -parse_run_time prog [] res NotDone = [] +parse_run_time :: String -> [String] -> Results -> Status + -> [(String, Results)] +parse_run_time _ [] _ NotDone = [] parse_run_time prog [] res ex = [(prog, res{run_status=ex})] parse_run_time prog (l:ls) res ex = - case matchRegex ghc1_re l of { - Just (allocs:_:_:_:_:init:_:mut:_:gc:_) -> - got_run_result allocs init mut gc Nothing - Nothing Nothing Nothing Nothing; - Nothing -> - - case matchRegex ghc2_re l of { - Just (allocs:_:_:_:_:_:init:_:mut:_:gc:_) -> - got_run_result allocs init mut gc Nothing - Nothing Nothing Nothing Nothing; - - Nothing -> - - case matchRegex ghc3_re l of { - Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_) -> - got_run_result allocs init mut gc (Just (read gc_work)) - Nothing Nothing Nothing Nothing; - - Nothing -> - - case matchRegex ghc4_re l of { - Just (allocs:_:_:_:_:gc_work:_:init:_:mut:_:gc:_:is:mem_rs:mem_ws:cache_misses:_) -> - got_run_result allocs init mut gc (Just (read gc_work)) - (Just (read is)) (Just (read mem_rs)) - (Just (read mem_ws)) (Just (read cache_misses)); - - Nothing -> - - case matchRegex wrong_output l of { - Just ("stdout":_) -> - parse_run_time prog ls res (combineRunResult WrongStdout ex); - Just ("stderr":_) -> - parse_run_time prog ls res (combineRunResult WrongStderr ex); - Nothing -> - - case matchRegex wrong_exit_status l of { - Just (wanted:got:_) -> - parse_run_time prog ls res (combineRunResult (Exit (read got)) ex); - Nothing -> - - case matchRegex out_of_heap l of { - Just _ -> - parse_run_time prog ls res (combineRunResult OutOfHeap ex); - Nothing -> - - case matchRegex out_of_stack l of { - Just _ -> - parse_run_time prog ls res (combineRunResult OutOfStack ex); - Nothing -> - parse_run_time prog ls res ex; - - }}}}}}}} + case ghc1_re l of { + Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> + got_run_result allocations initialisation mut gc Nothing + Nothing Nothing Nothing Nothing; + Nothing -> + + case ghc2_re l of { + Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> + got_run_result allocations initialisation mut gc Nothing + Nothing Nothing Nothing Nothing; + + Nothing -> + + case ghc3_re l of { + Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, _, gc, _) -> + got_run_result allocations initialisation mut gc + (Just gc_work') Nothing Nothing Nothing Nothing; + + Nothing -> + + case ghc4_re l of { + Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, _, gc, _, is, mem_rs, mem_ws, cache_misses') -> + got_run_result allocations initialisation mut gc + (Just gc_work') (Just is) (Just mem_rs) + (Just mem_ws) (Just cache_misses'); + + Nothing -> + + case matchRegex wrong_output l of { + Just ["stdout"] -> + parse_run_time prog ls res (combineRunResult WrongStdout ex); + Just ["stderr"] -> + parse_run_time prog ls res (combineRunResult WrongStderr ex); + Just _ -> error "wrong_output: Can't happen"; + Nothing -> + + case matchRegex wrong_exit_status l of { + Just [_wanted, got] -> + parse_run_time prog ls res (combineRunResult (Exit (read got)) ex); + Just _ -> error "wrong_exit_status: Can't happen"; + Nothing -> + + case matchRegex out_of_heap l of { + Just _ -> + parse_run_time prog ls res (combineRunResult OutOfHeap ex); + Nothing -> + + case matchRegex out_of_stack l of { + Just _ -> + parse_run_time prog ls res (combineRunResult OutOfStack ex); + Nothing -> + parse_run_time prog ls res ex; + + }}}}}}}} where - got_run_result allocs init mut gc gc_work instrs mem_rs mem_ws cache_misses - = -- trace ("got_run_result: " ++ init ++ ", " ++ mut ++ ", " ++ gc) $ - let - read_mut = read mut - read_gc = read gc - time = (read init + read_mut + read_gc) :: Float - res' = combine2Results res - emptyResults{ run_time = [time], - mut_time = [read_mut], - gc_time = [read_gc], - gc_work = gc_work, - allocs = Just (read allocs), - instrs = instrs, - mem_reads = mem_rs, - mem_writes = mem_ws, - cache_misses = cache_misses, - run_status = Success - } - in - parse_run_time prog ls res' Success - - + got_run_result allocations initialisation mut gc gc_work' instrs' mem_rs mem_ws cache_misses' + = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $ + let + time = initialisation + mut + gc + res' = combine2Results res + emptyResults{ run_time = [time], + mut_time = [mut], + gc_time = [gc], + gc_work = gc_work', + allocs = Just allocations, + instrs = instrs', + mem_reads = mem_rs, + mem_writes = mem_ws, + cache_misses = cache_misses', + run_status = Success + } + in + parse_run_time prog ls res' Success + +combineRunResult :: Status -> Status -> Status combineRunResult OutOfHeap _ = OutOfHeap combineRunResult _ OutOfHeap = OutOfHeap combineRunResult OutOfStack _ = OutOfStack combineRunResult _ OutOfStack = OutOfStack combineRunResult (Exit e) _ = Exit e combineRunResult _ (Exit e) = Exit e -combineRunResult exit _ = exit - -parse_size prog mod [] = [] -parse_size prog mod (l:ls) = - case matchRegex size_re l of - Nothing -> parse_size prog mod ls - Just (text:datas:bss:_) - | prog == mod -> - [(prog,emptyResults{binary_size = - Just (read text + read datas), - compile_status = Success})] - | otherwise -> - let ms = addToFM emptyFM mod (read text + read datas) - in - [(prog,emptyResults{module_size = ms})] +combineRunResult exit _ = exit + +parse_size :: String -> String -> [String] -> [(String, Results)] +parse_size _ _ [] = [] +parse_size progName modName (l:ls) = + case size_re l of + Nothing -> parse_size progName modName ls + Just (text, datas, _bss) + | progName == modName -> + [(progName,emptyResults{binary_size = + Just (text + datas), + compile_status = Success})] + | otherwise -> + let ms = Map.singleton modName (text + datas) + in + [(progName,emptyResults{module_size = ms})]