| OptTitle String
| OptColumns String
| OptRows String
+ | OptCSV String
+ | OptNoNormalise
| OptHelp
deriving Eq
"Specify columns for summary table (comma separates)"
, Option [] ["rows"] (ReqArg OptRows "ROWS")
"Specify rows for summary table (comma separates)"
+ , Option [] ["csv"] (ReqArg OptCSV "TABLE")
+ "Output a single table in CSV format"
+ , Option [] ["no-normalise"] (NoArg OptNoNormalise)
+ "Do not normalise to the baseline"
, Option ['n'] ["nodeviations"] (NoArg OptNoDeviations)
"Hide deviations"
, Option ['t'] ["title"] (ReqArg OptTitle "title")
let { html = OptHTMLOutput `elem` flags;
latex = OptLaTeXOutput `elem` flags;
- ascii = OptASCIIOutput `elem` flags
+ ascii = OptASCIIOutput `elem` flags;
+ csv = [ table | OptCSV table <- flags ];
+ no_norm = OptNoNormalise `elem` flags;
}
when (ascii && html) $ die "Can't produce both ASCII and HTML"
(prog,res) <- Map.toList result_table ]
case () of
+ _ | not (null csv) ->
+ putStr (csvTable results (head csv) (not no_norm))
_ | html ->
putStr (renderHtml (htmlPage results column_headings))
_ | latex ->
-- The various per-program aspects of execution that we can generate results for.
size_spec, alloc_spec, runtime_spec, muttime_spec, mutetime_spec,
gctime_spec, gcelap_spec,
- gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec
+ gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec,
+ gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec, balance_spec
:: PerProgTableSpec
size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
alloc_spec = SpecP "Allocations" "Allocs" "allocations" allocs run_status always_ok
mutetime_spec = SpecP "Mutator Elapsed Time" "MutETime" "mutator-elapsed-time" (mean mut_elapsed_time) run_status time_ok
gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status time_ok
gcelap_spec = SpecP "GC Elapsed Time" "GCETime" "gc-elapsed-time" (mean gc_elapsed_time) run_status time_ok
+gc0time_spec = SpecP "GC(0) Time" "GC0Time" "gc0-time" (mean gc0_time) run_status time_ok
+gc0elap_spec = SpecP "GC(0) Elapsed Time" "GC0ETime" "gc0-elapsed-time" (mean gc0_elapsed_time) run_status time_ok
+gc1time_spec = SpecP "GC(1) Time" "GC1Time" "gc1-time" (mean gc1_time) run_status time_ok
+gc1elap_spec = SpecP "GC(1) Elapsed Time" "GC1ETime" "gc1-elapsed-time" (mean gc1_elapsed_time) run_status time_ok
+balance_spec = SpecP "GC work balance" "Balance" "balance" (mean balance) run_status time_ok
gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" gc_work run_status always_ok
instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
mutetime_spec,
gctime_spec,
gcelap_spec,
+ gc0time_spec,
+ gc0elap_spec,
+ gc1time_spec,
+ gc1elap_spec,
+ balance_spec,
gcwork_spec,
instrs_spec,
mreads_spec,
-- These are the per-prog tables we want to generate
per_prog_result_tab :: [PerProgTableSpec]
per_prog_result_tab =
- [ size_spec, alloc_spec, runtime_spec, muttime_spec, mutetime_spec,
- gctime_spec, gcelap_spec,
- gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ]
+ [ size_spec, alloc_spec, runtime_spec, muttime_spec, mutetime_spec, gctime_spec,
+ gcelap_spec, gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec,
+ gcwork_spec, balance_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec]
-- A single summary table, giving comparison figures for a number of
-- aspects, each in its own column. Only works when comparing two runs.
++ [tableRow (-1) ("Average", gms)])
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
- results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
+ results_per_prog = map (calc_result rs f stat result_ok convert_to_percentage) (Map.toList r)
results_per_run = transpose (map snd results_per_prog)
(lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
Just res -> f res
get_results_for_mod id_attr
- = calc_result fms Just (const Success) result_ok id_attr
+ = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
show_results_for_prog (prog,mrs) =
td <! [valign "top"] << bold << prog
. show_per_prog_results ("Average",gms)
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
- results_per_prog = map (calc_result rs f stat result_ok) (Map.toList r)
+ results_per_prog = map (calc_result rs f stat result_ok convert_to_percentage) (Map.toList r)
results_per_run = transpose (map snd results_per_prog)
(lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
-- throw away the baseline result
= (heading, column, [column_min, column_max, column_mean])
where (_, boxes) = unzip (map calc_one_result baseline)
- calc_one_result = calc_result [r2] getr gets ok
+ calc_one_result = calc_result [r2] getr gets ok convert_to_percentage
column = map (\(_:b:_) -> b) boxes
(_, column_mean, _) = calc_gmsd column
(column_min, column_max) = calc_minmax column
Just res -> f res
get_results_for_mod id_attr
- = calc_result fms Just (const Success) result_ok id_attr
+ = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
show_results_for_prog (prog,mrs) =
str ("\n"++prog++"\n")
. str (space 5)
. foldr (.) id (map (str . rjustify w . showBox) results)
+-- -----------------------------------------------------------------------------
+-- CSV output
+
+csvTable :: [ResultTable] -> String -> Bool -> String
+csvTable results table_name norm
+ = let
+ table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab,
+ n == table_name ]
+ in
+ case table_spec of
+ [] -> error ("can't find table named: " ++ table_name)
+ (spec:_) -> csvProgTable results spec norm "\n"
+
+csvProgTable :: [ResultTable] -> PerProgTableSpec -> Bool -> ShowS
+csvProgTable results (SpecP long_name _ _ get_result get_status result_ok) norm
+ = csv_show_results results get_result get_status result_ok norm
+
+csv_show_results
+ :: Result a
+ => [ResultTable]
+ -> (Results -> Maybe a)
+ -> (Results -> Status)
+ -> (a -> Bool)
+ -> Bool
+ -> ShowS
+
+csv_show_results [] _ _ _ _
+ = error "csv_show_results: Can't happen?"
+csv_show_results (r:rs) f stat result_ok norm
+ = interleave "\n" results_per_prog
+ where
+ -- results_per_prog :: [ (String,[BoxValue a]) ]
+ results_per_prog = map (result_line . calc) (Map.toList r)
+ calc = calc_result rs f stat (const True) do_norm
+
+ do_norm | norm = normalise_to_base
+ | otherwise = \base res -> toBox res
+
+ result_line (prog,boxes) = interleave "," (str prog : map (str.showBox) boxes)
+
-- ---------------------------------------------------------------------------
-- Generic stuff for results generation
=> [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?
+ -> (a -> Bool) -- normalise against the baseline?
+ -> (a -> a -> BoxValue) -- how to normalise
-> (String,b) -- the baseline result
-> (String,[BoxValue])
-calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
+calc_result rts get_maybe_a get_stat base_ok normalise (prog,base_r) =
(prog, (just_result m_baseline base_stat :
let
in
(
case m_baseline of
- Just baseline
- | result_ok baseline
- -> map (\(r,s) -> percentage r s baseline) rts'
- _ -> map (\(r,s) -> just_result r s) rts'
+ Just baseline | base_ok baseline
+ -> map (\(r,s) -> do_norm r s baseline) rts'
+ _other
+ -> map (\(r,s) -> just_result r s) rts'
)))
where
m_baseline = get_maybe_a base_r
just_result Nothing s = RunFailed s
just_result (Just a) _ = toBox a
- percentage Nothing s _ = RunFailed s
- percentage (Just a) _ baseline
- = Percentage (convert_to_percentage baseline a)
+ do_norm Nothing s _ = RunFailed s
+ do_norm (Just a) _ baseline = normalise baseline a
+
-----------------------------------------------------------------------------
-- Calculating geometric means and standard deviations
-----------------------------------------------------------------------------
-- Show the Results
-class Num a => Result a where
+convert_to_percentage :: Result a => a -> a -> BoxValue
+convert_to_percentage 0 val = Percentage 100
+convert_to_percentage baseline val = Percentage ((realToFrac val / realToFrac baseline) * 100)
+
+normalise_to_base :: Result a => a -> a -> BoxValue
+normalise_to_base 0 val = BoxFloat 1
+normalise_to_base baseline val = BoxFloat (realToFrac baseline / realToFrac val)
+
+class Real a => Result a where
toBox :: a -> BoxValue
- convert_to_percentage :: a -> a -> Float
-- We assume an Int is a size, and print it in kilobytes.
instance Result Int where
- convert_to_percentage 0 _ = 100
- convert_to_percentage baseline val
- = (fromIntegral val / fromIntegral baseline) * 100
-
toBox = BoxInt
instance Result Integer where
- convert_to_percentage 0 _ = 100
- convert_to_percentage baseline val
- = (fromInteger val / fromInteger baseline) * 100
toBox = BoxInteger
instance Result Float where
- convert_to_percentage 0.0 _ = 100.0
- convert_to_percentage baseline val = val / baseline * 100
-
toBox = BoxFloat
-- -----------------------------------------------------------------------------
SRC_HC_OPTS += -package regex-compat -package html
endif
+ifeq "$(ghc_ge_607)" "YES"
+SRC_HC_OPTS += -package containers
+endif
+
include $(TOP)/mk/target.mk
gc_work :: Maybe Integer,
gc_time :: [Float],
gc_elapsed_time :: [Float],
+ gc0_time :: [Float],
+ gc0_elapsed_time :: [Float],
+ gc1_time :: [Float],
+ gc1_elapsed_time :: [Float],
+ balance :: [Float],
allocs :: Maybe Integer,
run_status :: Status,
compile_status :: Status
cache_misses = Nothing,
gc_time = [],
gc_elapsed_time = [],
+ gc0_time = [],
+ gc0_elapsed_time = [],
+ gc1_time = [],
+ gc1_elapsed_time = [],
+ balance = [],
gc_work = Nothing,
allocs = Nothing,
compile_status = NotDone,
ghc1_re = pre GHC 4.02
ghc2_re = GHC 4.02 (includes "xxM in use")
ghc3_re = GHC 4.03 (includes "xxxx bytes GC work")
+ghc5_re = GHC 6.9 (includes GC(0) and GC(1) times)
-}
ghc1_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float)
Nothing -> Nothing
where re = mkRegex "^<<ghc-instrs:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9]+) instructions, ([0-9]+) memory reads, ([0-9]+) memory writes, ([0-9]+) L2 cache misses :ghc-instrs>>"
+ghc5_re :: String -> Maybe (Integer, Integer, Integer, Integer, Integer, Integer, Integer, Float, Float, Float, Float, Float, Float,Float,Float,Float,Float,Float)
+ghc5_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, gc0, gc0_elapsed, gc1, gc1_elapsed, bal] ->
+ 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 gc0, read gc0_elapsed, read gc1, read gc1_elapsed, read bal)
+ Just _ -> error "ghc3_re: Can't happen"
+ Nothing -> Nothing
+ where re = mkRegex "^<<ghc:[ \t]+([0-9]+)[ \t]+bytes,[ \t]*([0-9]+)[ \t]+GCs,[ \t]*([0-9]+)/([0-9]+)[ \t]+avg/max bytes residency \\(([0-9]+) samples\\), ([0-9]+) bytes GC work, ([0-9]+)M in use, ([0-9.]+) INIT \\(([0-9.]+) elapsed\\), ([0-9.]+) MUT \\(([0-9.]+) elapsed\\), ([0-9.]+) GC \\(([0-9.]+) elapsed\\), ([0-9.]+) GC\\(0\\) \\(([0-9.]+) elapsed\\), ([0-9.]+) GC\\(1\\) \\(([0-9.]+) elapsed\\), ([0-9.]+) balance :ghc>>"
+
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]+)"
wrong_output = mkRegex "^expected (stdout|stderr) not matched by reality$"
instrs = is1, mem_reads = mr1, mem_writes = mw1,
cache_misses = cm1,
gc_time = gt1, gc_elapsed_time = ge1, gc_work = gw1,
+ gc0_time = g0t1, gc0_elapsed_time = g0e1,
+ gc1_time = g1t1, gc1_elapsed_time = g1e1,
+ balance = b1,
binary_size = bs1, allocs = al1,
run_status = rs1, compile_status = cs1 }
Results{ compile_time = ct2, link_time = lt2,
instrs = is2, mem_reads = mr2, mem_writes = mw2,
cache_misses = cm2,
gc_time = gt2, gc_elapsed_time = ge2, gc_work = gw2,
+ gc0_time = g0t2, gc0_elapsed_time = g0e2,
+ gc1_time = g1t2, gc1_elapsed_time = g1e2,
+ balance = b2,
binary_size = bs2, allocs = al2,
run_status = rs2, compile_status = cs2 }
= Results{ compile_time = Map.unionWith (flip const) ct1 ct2,
cache_misses = cm1 `mplus` cm2,
gc_time = gt1 ++ gt2,
gc_elapsed_time= ge1 ++ ge2,
+ gc0_time = g0t1 ++ g0t2,
+ gc0_elapsed_time= g0e1 ++ g0e2,
+ gc1_time = g1t1 ++ g1t2,
+ gc1_elapsed_time= g1e1 ++ g1e2,
+ balance = b1 ++ b2,
gc_work = gw1 `mplus` gw2,
binary_size = bs1 `mplus` bs2,
allocs = al1 `mplus` al2,
parse_run_time prog (l:ls) res ex =
case ghc1_re l of {
Just (allocations, _, _, _, _, _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) ->
- got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
+ got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] []
Nothing Nothing Nothing Nothing Nothing;
Nothing ->
case ghc2_re l of {
Just (allocations, _, _, _, _, _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) ->
- got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
+ got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] []
Nothing Nothing Nothing Nothing Nothing;
Nothing ->
case ghc3_re l of {
Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed) ->
- got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
+ got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] []
(Just gc_work') Nothing Nothing Nothing Nothing;
Nothing ->
case ghc4_re l of {
Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed, is, mem_rs, mem_ws, cache_misses') ->
- got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
+ got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed [] [] [] [] []
(Just gc_work') (Just is) (Just mem_rs)
(Just mem_ws) (Just cache_misses');
Nothing ->
+ case ghc5_re l of {
+ Just (allocations, _, _, _, _, gc_work', _, initialisation, _, mut, mut_elapsed, gc, gc_elapsed, gc0, gc0_elapsed, gc1, gc1_elapsed, bal) ->
+ got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed
+ [gc0] [gc0_elapsed] [gc1] [gc1_elapsed] [bal]
+ (Just gc_work') Nothing Nothing Nothing Nothing;
+
+ Nothing ->
+
case matchRegex wrong_output l of {
Just ["stdout"] ->
parse_run_time prog ls res (combineRunResult WrongStdout ex);
Nothing ->
parse_run_time prog ls res ex;
- }}}}}}}}
+ }}}}}}}}}
where
- got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed gc_work' instrs' mem_rs mem_ws cache_misses'
+ got_run_result allocations initialisation mut mut_elapsed gc gc_elapsed gc0 gc0_elapsed gc1 gc1_elapsed bal gc_work' instrs' mem_rs mem_ws cache_misses'
= -- trace ("got_run_result: " ++ initialisation ++ ", " ++ mut ++ ", " ++ gc) $
let
time = initialisation + mut + gc
mut_elapsed_time = [mut_elapsed],
gc_time = [gc],
gc_elapsed_time = [gc_elapsed],
+ gc0_time = gc0,
+ gc0_elapsed_time = gc0_elapsed,
+ gc1_time = gc1,
+ gc1_elapsed_time = gc1_elapsed,
+ balance = bal,
gc_work = gc_work',
allocs = Just allocations,
instrs = instrs',
Nothing -> parse_size progName modName ls
Just (text, datas, _bss)
| progName == modName ->
- [(progName,emptyResults{binary_size =
- Just (text + datas),
+ [(progName,emptyResults{binary_size =
+ Just (text + datas),
compile_status = Success})]
| otherwise ->
let ms = Map.singleton modName (text + datas)
projects / ghc-hetmet.git / commitdiff