From 7f54886b21c58cdb733c0e26b2a7710e6ed9586e Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Tue, 12 Dec 2006 20:04:22 +0000 Subject: [PATCH] Fix more warnings --- utils/nofib-analyse/Slurp.hs | 189 ++++++++++++++++++++++++------------------ 1 file changed, 107 insertions(+), 82 deletions(-) diff --git a/utils/nofib-analyse/Slurp.hs b/utils/nofib-analyse/Slurp.hs index 16dfdc1..5387a8f 100644 --- a/utils/nofib-analyse/Slurp.hs +++ b/utils/nofib-analyse/Slurp.hs @@ -86,16 +86,32 @@ This regexp for the output of "time" works on FreeBSD, other versions of "time" will need different regexps. -} -time_re :: Regex -time_re = mkRegex "^[ \t]*([0-9.]+)[ \t]+real[ \t]+([0-9.]+)[ \t]+user[ \t]+([0-9.]+)[ \t]+sys[ \t]*$" - -time_gnu17_re :: Regex -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 :: Regex -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]+)" {- <> @@ -108,14 +124,37 @@ ghc2_re = GHC 4.02 (includes "xxM in use") ghc3_re = GHC 4.03 (includes "xxxx bytes GC work") -} -ghc1_re, ghc2_re, ghc3_re, ghc4_re :: Regex -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]+)" @@ -196,60 +235,46 @@ 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 matchRegex time_re l of { - Just (_real:user:_system:_) -> - let ct = Map.singleton modName (read user) + case time_re l of { + Just (_real, user, _system) -> + let ct = Map.singleton modName user in [(progName, emptyResults{compile_time = ct})]; Nothing -> - case matchRegex time_gnu17_re l of { - Just (user:_system:_elapsed:_) -> - let ct = Map.singleton modName (read user) + case time_gnu17_re l of { + Just (user, _system, _elapsed) -> + let ct = Map.singleton modName user in [(progName, emptyResults{compile_time = ct})]; Nothing -> - case matchRegex ghc1_re l of { - Just (_allocations:_:_:_:_:initialisation:_:mut:_:gc:_) -> + case ghc1_re l of { + Just (_, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> let - read_mut = read mut - read_gc = read gc - time = (read initialisation + read_mut + read_gc) :: Float + time = (initialisation + mut + gc) :: Float ct = Map.singleton modName time in [(progName, emptyResults{compile_time = ct})]; Nothing -> - case matchRegex ghc2_re l of { - Just (_allocations:_:_:_:_:_:initialisation:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read initialisation + read_mut + read_gc) :: Float - ct = Map.singleton modName time + 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 matchRegex ghc3_re l of { - Just (_allocations:_:_:_:_:_:_:initialisation:_:mut:_:gc:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read initialisation + read_mut + read_gc) :: Float - ct = Map.singleton modName time + 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 matchRegex ghc4_re l of { - Just (_allocations:_:_:_:_:_:_:initialisation:_:mut:_:gc:_:_:_:_) -> - let - read_mut = read mut - read_gc = read gc - time = (read initialisation + read_mut + read_gc) :: Float - ct = Map.singleton modName time + case ghc4_re l of { + Just (_, _, _, _, _, _, _, initialisation, _, mut, _, gc, _, _, _, _, _) -> + let ct = Map.singleton modName (initialisation + mut + gc) in [(progName, emptyResults{compile_time = ct})]; Nothing -> @@ -260,14 +285,14 @@ parse_compile_time progName modName (l: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)})]; + 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)})]; + case time_gnu17_re l of { + Just (user, _system, _elapsed) -> + [(prog,emptyResults{link_time = Just user})]; Nothing -> parse_link_time prog ls @@ -282,44 +307,46 @@ parse_run_time :: String -> [String] -> Results -> Status 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 (allocations:_:_:_:_:initialisation:_:mut:_:gc:_) -> + case ghc1_re l of { + Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> got_run_result allocations initialisation mut gc Nothing Nothing Nothing Nothing Nothing; Nothing -> - case matchRegex ghc2_re l of { - Just (allocations:_:_:_:_:_:initialisation:_:mut:_:gc:_) -> + case ghc2_re l of { + Just (allocations, _, _, _, _, _, initialisation, _, mut, _, gc, _) -> got_run_result allocations initialisation mut gc Nothing Nothing Nothing Nothing Nothing; Nothing -> - case matchRegex ghc3_re l of { - Just (allocations:_:_:_:_:gc_work':_:initialisation:_:mut:_:gc:_) -> - got_run_result allocations initialisation mut gc (Just (read gc_work')) - 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 matchRegex 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 (read gc_work')) - (Just (read is)) (Just (read mem_rs)) - (Just (read mem_ws)) (Just (read cache_misses')); + 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":_) -> + Just ["stdout"] -> parse_run_time prog ls res (combineRunResult WrongStdout ex); - Just ("stderr":_) -> + 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:_) -> + 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 { @@ -338,15 +365,13 @@ parse_run_time prog (l:ls) res ex = got_run_result allocations initialisation mut gc gc_work' instrs' mem_rs mem_ws cache_misses' = -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $ let - read_mut = read mut - read_gc = read gc - time = (read initialisation + read_mut + read_gc) :: Float + time = initialisation + mut + gc res' = combine2Results res emptyResults{ run_time = [time], - mut_time = [read_mut], - gc_time = [read_gc], + mut_time = [mut], + gc_time = [gc], gc_work = gc_work', - allocs = Just (read allocations), + allocs = Just allocations, instrs = instrs', mem_reads = mem_rs, mem_writes = mem_ws, @@ -368,15 +393,15 @@ combineRunResult exit _ = exit parse_size :: String -> String -> [String] -> [(String, Results)] parse_size _ _ [] = [] parse_size progName modName (l:ls) = - case matchRegex size_re l of + case size_re l of Nothing -> parse_size progName modName ls - Just (text:datas:_bss:_) + Just (text, datas, _bss) | progName == modName -> [(progName,emptyResults{binary_size = - Just (read text + read datas), + Just (text + datas), compile_status = Success})] | otherwise -> - let ms = Map.singleton modName (read text + read datas) + let ms = Map.singleton modName (text + datas) in [(progName,emptyResults{module_size = ms})] -- 1.7.10.4