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)"
projects / ghc-hetmet.git / blobdiff