From: Simon Marlow Date: Mon, 16 Oct 2006 15:19:35 +0000 (+0000) Subject: remove use of FiniteMap, use Text.Printf X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=a2775fd805a268b4a7c15a805b4d7f51c1805a81 remove use of FiniteMap, use Text.Printf --- diff --git a/utils/nofib-analyse/Main.hs b/utils/nofib-analyse/Main.hs index 9e298c9..b8f7ab0 100644 --- a/utils/nofib-analyse/Main.hs +++ b/utils/nofib-analyse/Main.hs @@ -7,13 +7,14 @@ module Main where import GenUtils -import Text.Printf import Slurp import CmdLine +import Text.Printf import Text.Html hiding ((!)) import qualified Text.Html as Html ((!)) -import Data.FiniteMap +import qualified Data.Map as Map +import Data.Map (Map) import System.Console.GetOpt import System.Exit ( exitWith, ExitCode(..) ) @@ -66,7 +67,7 @@ main = do -- sanity check sequence_ [ checkTimes prog res | table <- results, - (prog,res) <- fmToList table ] + (prog,res) <- Map.toList table ] case () of _ | html -> @@ -104,7 +105,7 @@ data PerModuleTableSpec = SpecM String -- Name of the table String -- HTML tag for the table - (Results -> FiniteMap String a) -- get the module map + (Results -> Map String a) -- get the module map (a -> Bool) -- Result within reasonable limits? -- The various per-program aspects of execution that we can generate results for. @@ -182,7 +183,7 @@ cachegrind_summary_specs = -- in instructions, mem reads and mem writes (and vice-versa). pickSummary :: [ResultTable] -> [PerProgTableSpec] pickSummary rs - | isNothing (instrs (head (eltsFM (head rs)))) = normal_summary_specs + | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs | otherwise = cachegrind_summary_specs per_module_result_tab = @@ -251,7 +252,7 @@ htmlShowResults (r:rs) ss f stat result_ok ++ [tableRow (-1) ("Average", gms)]) where -- results_per_prog :: [ (String,[BoxValue a]) ] - results_per_prog = map (calc_result rs f stat result_ok) (fmToList r) + results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r) results_per_run = transpose (map snd results_per_prog) (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) @@ -260,7 +261,7 @@ htmlShowMultiResults :: Result a => [ResultTable] -> [String] - -> (Results -> FiniteMap String a) + -> (Results -> Map String a) -> (a -> Bool) -> HtmlTable @@ -276,18 +277,18 @@ htmlShowMultiResults (r:rs) ss f result_ok = <-> tableRow (-1) ("", gms)]) where - base_results = fmToList r :: [(String,Results)] + base_results = Map.toList r :: [(String,Results)] -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])] results_per_prog_mod_run = map get_results_for_prog base_results -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a]) - get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r))) + get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r))) where fms = map get_run_results rs - get_run_results fm = case lookupFM fm prog of - Nothing -> emptyFM + get_run_results fm = case Map.lookup prog fm of + Nothing -> Map.empty Just res -> f res get_results_for_mod (id,attr) = calc_result fms Just (const Success) @@ -423,7 +424,7 @@ ascii_show_results (r:rs) ss f stat result_ok . show_per_prog_results ("Average",gms) where -- results_per_prog :: [ (String,[BoxValue a]) ] - results_per_prog = map (calc_result rs f stat result_ok) (fmToList r) + results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r) results_per_run = transpose (map snd results_per_prog) (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) @@ -446,8 +447,8 @@ ascii_summary_table latex (r1:r2:_) specs mb_restrict (headings, columns, av_cols) = unzip3 (map calc_col specs) av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"] - baseline = fmToList r1 - progs = map BoxString (keysFM r1) + baseline = Map.toList r1 + progs = map BoxString (Map.keys r1) rows0 = map TableRow (zipWith (:) progs (transpose columns)) rows1 = restrictRows mb_restrict rows0 @@ -494,7 +495,7 @@ ascii_show_multi_results :: Result a => [ResultTable] -> [String] - -> (Results -> FiniteMap String a) + -> (Results -> Map String a) -> (a -> Bool) -> ShowS @@ -510,18 +511,18 @@ ascii_show_multi_results (r:rs) ss f result_ok . str "\n" . show_per_prog_results ("Average",gms) where - base_results = fmToList r :: [(String,Results)] + base_results = Map.toList r :: [(String,Results)] -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])] results_per_prog_mod_run = map get_results_for_prog base_results -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a]) - get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r))) + get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r))) where fms = map get_run_results rs - get_run_results fm = case lookupFM fm prog of - Nothing -> emptyFM + get_run_results fm = case Map.lookup prog fm of + Nothing -> Map.empty Just res -> f res get_results_for_mod (id,attr) = calc_result fms Just (const Success) @@ -553,7 +554,7 @@ show_per_prog_results_width width (prog,results) -- calc_result is a nice exercise in higher-order programming... calc_result :: Result a - => [FiniteMap String b] -- accumulated results + => [Map String b] -- accumulated results -> (b -> Maybe a) -- get a result from the b -> (b -> Status) -- get a status from the b -> (a -> Bool) -- is this result ok? @@ -564,7 +565,7 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = (prog, (just_result baseline base_stat : let - rts' = map (\rt -> get_stuff (lookupFM rt prog)) rts + rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts get_stuff Nothing = (Nothing, NotDone) get_stuff (Just r) = (get_maybe_a r, get_stat r) @@ -689,17 +690,18 @@ data BoxValue showBox :: BoxValue -> String showBox (RunFailed stat) = show_stat stat showBox (Percentage f) = show_pcntage f -showBox (BoxFloat f) = showFFloat (Just 2) f "" +showBox (BoxFloat f) = printf "%.2f" f showBox (BoxInt n) = show (n `div` 1024) ++ "k" showBox (BoxInteger n) = show (n `div` 1024) ++ "k" showBox (BoxString s) = s instance Show BoxValue where { show = showBox } -show_pcntage n = showFFloat (Just 1) (n-100) "%" ---show_pcntage n = show_float_signed (n-100) ++ "%" +show_pcntage n = show_float_signed (n-100) ++ "%" ---show_float_signed = showFloat False False True False False Nothing (Just 1) +show_float_signed n + | n >= 0 = printf "+%.1f" n + | otherwise = printf "%.1f" n show_stat Success = "(no result)" show_stat WrongStdout = "(stdout)" diff --git a/utils/nofib-analyse/Printf.lhs b/utils/nofib-analyse/Printf.lhs deleted file mode 100644 index 33b5290..0000000 --- a/utils/nofib-analyse/Printf.lhs +++ /dev/null @@ -1,84 +0,0 @@ ------------------------------------------------------------------------------ --- $Id: Printf.lhs,v 1.5 2002/03/14 17:09:46 simonmar Exp $ - --- (c) Simon Marlow 1997-2001 ------------------------------------------------------------------------------ - -> module Printf (showFloat, showFloat') where - -> import Foreign -> import CTypes -> import CTypesISO -> import CString -> import IOExts -> import ByteArray - -> showFloat -> :: Bool -- Always print decimal point -> -> Bool -- Left adjustment -> -> Bool -- Always print sign -> -> Bool -- Leave blank before positive number -> -> Bool -- Use zero padding -> -> Maybe Int -- Field Width -> -> Maybe Int -- Precision -> -> Float -> -> String - -> bUFSIZE = 512 :: Int - -> showFloat alt left sign blank zero width prec num = -> unsafePerformIO $ do - -#if __GLASGOW_HASKELL__ < 500 - -> buf <- malloc bUFSIZE -> snprintf buf (fromIntegral bUFSIZE) (packString format) -> (realToFrac num) -> let s = unpackCString buf -> length s `seq` -- urk! need to force the string before we -> -- free the buffer. A better solution would -> -- be to use foreign objects and finalisers, -> -- but that's just too heavyweight. -> free buf -> return s - -#else - -> allocaBytes bUFSIZE $ \buf -> -> withCString format $ \cformat -> do -> snprintf buf (fromIntegral bUFSIZE) cformat -> (realToFrac num) -> peekCString buf - -#endif - -> where -> format = '%' : -> if_bool alt "#" ++ -> if_bool left "-" ++ -> if_bool sign "+" ++ -> if_bool blank " " ++ -> if_bool zero "0" ++ -> if_maybe width show ++ -> if_maybe prec (\s -> "." ++ show s) ++ -> "f" - -> showFloat' :: Maybe Int -> Maybe Int -> Float -> String -> showFloat' = showFloat False False False False False - -> if_bool False s = [] -> if_bool True s = s - -> if_maybe Nothing f = [] -> if_maybe (Just s) f = f s - -#if __GLASGOW_HASKELL__ < 500 - -> type PackedString = ByteArray Int -> foreign import unsafe snprintf :: Addr -> CSize -> PackedString -> Double -> IO () - -#else - -> foreign import unsafe snprintf :: CString -> CSize -> CString -> Double -> IO () - -#endif diff --git a/utils/nofib-analyse/Slurp.hs b/utils/nofib-analyse/Slurp.hs index 8305f3e..6fd7b47 100644 --- a/utils/nofib-analyse/Slurp.hs +++ b/utils/nofib-analyse/Slurp.hs @@ -7,7 +7,9 @@ module Slurp (Status(..), Results(..), ResultTable, parse_log) where import CmdLine -import Data.FiniteMap + +import qualified Data.Map as Map +import Data.Map (Map) import Text.Regex import Data.Maybe -- import Debug.Trace @@ -15,7 +17,7 @@ import Data.Maybe ----------------------------------------------------------------------------- -- This is the structure into which we collect our results: -type ResultTable = FiniteMap String Results +type ResultTable = Map String Results data Status = NotDone @@ -27,8 +29,8 @@ data Status | WrongStderr data Results = Results { - compile_time :: FiniteMap String Float, - module_size :: FiniteMap String Int, + compile_time :: Map String Float, + module_size :: Map String Int, binary_size :: Maybe Int, link_time :: Maybe Float, run_time :: [Float], @@ -45,8 +47,8 @@ data Results = Results { } emptyResults = Results { - compile_time = emptyFM, - module_size = emptyFM, + compile_time = Map.empty, + module_size = Map.empty, binary_size = Nothing, link_time = Nothing, run_time = [], @@ -127,10 +129,10 @@ parse_log . chunk_log [] [] -- break at banner lines . lines -combine_results :: [(String,Results)] -> FiniteMap String Results -combine_results = foldr f emptyFM +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 @@ -150,8 +152,8 @@ combine2Results 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, + = Results{ compile_time = Map.unionWith (flip const) ct1 ct2, + module_size = Map.unionWith (flip const) ms1 ms2, link_time = combMaybes lt1 lt2, run_time = rt1 ++ rt2, mut_time = mt1 ++ mt2, @@ -194,14 +196,14 @@ 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) + let ct = Map.singleton 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) + let ct = Map.singleton mod (read user) in [(prog,emptyResults{compile_time = ct})]; Nothing -> @@ -212,7 +214,7 @@ parse_compile_time prog mod (l:ls) = read_mut = read mut read_gc = read gc time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time + ct = Map.singleton mod time in [(prog,emptyResults{compile_time = ct})]; Nothing -> @@ -223,7 +225,7 @@ parse_compile_time prog mod (l:ls) = read_mut = read mut read_gc = read gc time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time + ct = Map.singleton mod time in [(prog,emptyResults{compile_time = ct})]; Nothing -> @@ -234,7 +236,7 @@ parse_compile_time prog mod (l:ls) = read_mut = read mut read_gc = read gc time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time + ct = Map.singleton mod time in [(prog,emptyResults{compile_time = ct})]; Nothing -> @@ -245,7 +247,7 @@ parse_compile_time prog mod (l:ls) = read_mut = read mut read_gc = read gc time = (read init + read_mut + read_gc) :: Float - ct = addToFM emptyFM mod time + ct = Map.singleton mod time in [(prog,emptyResults{compile_time = ct})]; Nothing -> @@ -368,7 +370,7 @@ parse_size prog mod (l:ls) = Just (read text + read datas), compile_status = Success})] | otherwise -> - let ms = addToFM emptyFM mod (read text + read datas) + let ms = Map.singleton mod (read text + read datas) in [(prog,emptyResults{module_size = ms})]