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(..) )
-- sanity check
sequence_ [ checkTimes prog res | table <- results,
- (prog,res) <- fmToList table ]
+ (prog,res) <- Map.toList table ]
case () of
_ | html ->
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.
-- 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 =
++ [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)
:: Result a
=> [ResultTable]
-> [String]
- -> (Results -> FiniteMap String a)
+ -> (Results -> Map String a)
-> (a -> Bool)
-> HtmlTable
<-> 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)
. 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)
(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
:: Result a
=> [ResultTable]
-> [String]
- -> (Results -> FiniteMap String a)
+ -> (Results -> Map String a)
-> (a -> Bool)
-> ShowS
. 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)
-- 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?
(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)
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)"
+++ /dev/null
------------------------------------------------------------------------------
--- $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
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
-----------------------------------------------------------------------------
-- This is the structure into which we collect our results:
-type ResultTable = FiniteMap String Results
+type ResultTable = Map String Results
data Status
= NotDone
| 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],
}
emptyResults = Results {
- compile_time = emptyFM,
- module_size = emptyFM,
+ compile_time = Map.empty,
+ module_size = Map.empty,
binary_size = Nothing,
link_time = Nothing,
run_time = [],
. 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
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,
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 ->
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 ->
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 ->
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 ->
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 ->
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})]
projects / ghc-hetmet.git / commitdiff