Skip to content

GitLab

Commit a2775fd8 authored by Simon Marlow's avatar Simon Marlow
Browse files

remove use of FiniteMap, use Text.Printf

parent 80b1239e
Hide whitespace changes
Inline Side-by-side
utils/nofib-analyse/Main.hs
View file @ a2775fd8
......@@ -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)"
......
utils/nofib-analyse/Printf.lhs deleted 100644 → 0
View file @ 80b1239e
-----------------------------------------------------------------------------
-- $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
utils/nofib-analyse/Slurp.hs
View file @ a2775fd8
......@@ -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})]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment