X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fnofib-analyse%2FMain.hs;h=7bcdd580cad3796be031b9c05f409396b98c86a6;hb=d7c2a370ea5fe189dad4aca4c8b3adbae13cfdbd;hp=a6e85926a2183f08f6480cee78317b18ec6a7a91;hpb=ddacc40c5275110a2a17402bab704bac371cf001;p=ghc-hetmet.git diff --git a/utils/nofib-analyse/Main.hs b/utils/nofib-analyse/Main.hs index a6e8592..7bcdd58 100644 --- a/utils/nofib-analyse/Main.hs +++ b/utils/nofib-analyse/Main.hs @@ -32,15 +32,25 @@ import Data.List die :: String -> IO a die s = hPutStr stderr s >> exitWith (ExitFailure 1) +data Normalise = NormalisePercent | NormaliseRatio | NormaliseNone + main :: IO () main = do when (not (null cmdline_errors) || OptHelp `elem` flags) $ die (concat cmdline_errors ++ usage) + norm <- case [ n | OptNormalise n <- flags ] of + [] -> return NormalisePercent + ["percent"] -> return NormalisePercent + ["ratio"] -> return NormaliseRatio + ["none"] -> return NormaliseNone + _ -> die ("unrecognised value for --normalise\n" ++ usage) + let { html = OptHTMLOutput `elem` flags; - latex = OptLaTeXOutput `elem` flags; - ascii = OptASCIIOutput `elem` flags + latex = [ t | OptLaTeXOutput t <- flags ]; + ascii = OptASCIIOutput `elem` flags; + csv = [ t | OptCSV t <- flags ]; } when (ascii && html) $ die "Can't produce both ASCII and HTML" @@ -63,12 +73,14 @@ main = do (prog,res) <- Map.toList result_table ] case () of + _ | not (null csv) -> + putStr (csvTable results (head csv) norm) _ | html -> putStr (renderHtml (htmlPage results column_headings)) - _ | latex -> - putStr (latexOutput results column_headings summary_spec summary_rows) + _ | not (null latex) -> + putStr (latexOutput results (head latex) column_headings summary_spec summary_rows norm) _ | otherwise -> - putStr (asciiPage results column_headings summary_spec summary_rows) + putStr (asciiPage results column_headings summary_spec summary_rows norm) parse_logs :: [String] -> IO [ResultTable] @@ -102,15 +114,24 @@ data PerModuleTableSpec = (a -> Bool) -- Result within reasonable limits? -- The various per-program aspects of execution that we can generate results for. -size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec, gcelap_spec, - gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec +size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec, + gctime_spec, gcelap_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 runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status time_ok +elapsedtime_spec = SpecP "Elapsed Time" "Elapsed" "elapsed-times" (mean elapsed_time) run_status time_ok muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_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 @@ -122,9 +143,16 @@ all_specs = [ size_spec, alloc_spec, runtime_spec, + elapsedtime_spec, muttime_spec, + mutetime_spec, gctime_spec, gcelap_spec, + gc0time_spec, + gc0elap_spec, + gc1time_spec, + gc1elap_spec, + balance_spec, gcwork_spec, instrs_spec, mreads_spec, @@ -167,15 +195,15 @@ checkTimes prog results = do -- 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, gctime_spec, - gcelap_spec, - gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec ] + [ size_spec, alloc_spec, runtime_spec, elapsedtime_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. normal_summary_specs :: [PerProgTableSpec] normal_summary_specs = - [ size_spec, alloc_spec, runtime_spec ] + [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec ] cachegrind_summary_specs :: [PerProgTableSpec] cachegrind_summary_specs = @@ -266,7 +294,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) (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) @@ -308,7 +336,7 @@ htmlShowMultiResults (r:rs) ss f result_ok = 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 = 0 = printf "#%02x0000" val ----------------------------------------------------------------------------- -- LaTeX table generation (just the summary for now) -latexOutput :: [ResultTable] -> [String] -> [PerProgTableSpec] - -> Maybe [String] -> String -latexOutput results _ summary_spec summary_rows = +latexOutput :: [ResultTable] -> Maybe String -> [String] -> [PerProgTableSpec] + -> Maybe [String] -> Normalise -> String + +latexOutput results (Just 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:_) -> latexProgTable results spec norm "\n" + +latexOutput results Nothing _ summary_spec summary_rows _ = (if (length results == 2) then ascii_summary_table True results summary_spec summary_rows . str "\n\n" else id) "" +latexProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> ShowS +latexProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm + = latex_show_results results get_result get_status result_ok norm + +latex_show_results + :: Result a + => [ResultTable] + -> (Results -> Maybe a) + -> (Results -> Status) + -> (a -> Bool) + -> Normalise + -> ShowS + +latex_show_results [] _ _ _ _ + = error "latex_show_results: Can't happen?" +latex_show_results (r:rs) f stat _result_ok norm + = makeLatexTable $ + [ TableRow (BoxString prog : boxes) | + (prog,boxes) <- results_per_prog ] ++ + if nodevs then [] else + [ TableLine, + TableRow (BoxString "Min" : mins), + TableRow (BoxString "Max" : maxs), + TableRow (BoxString "Geometric Mean" : gms) ] + where + -- results_per_prog :: [ (String,[BoxValue a]) ] + results_per_prog = [ (prog,tail xs) | (prog,xs) <- map calc (Map.toList r) ] + calc = calc_result rs f stat (const True) (normalise norm) + + results_per_run = transpose (map snd results_per_prog) + (_lows,gms,_highs) = unzip3 (map calc_gmsd results_per_run) + (mins, maxs) = unzip (map calc_minmax results_per_run) + +normalise :: Result a => Normalise -> a -> a -> BoxValue +normalise norm = case norm of + NormalisePercent -> convert_to_percentage + NormaliseRatio -> normalise_to_base + NormaliseNone -> \_base res -> toBox res + ----------------------------------------------------------------------------- -- ASCII page generation asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String] + -> Normalise -> String -asciiPage results args summary_spec summary_rows = +asciiPage results args summary_spec summary_rows norm = ( str reportTitle . str "\n\n" -- only show the summary table if we're comparing two runs . (if (length results == 2) then ascii_summary_table False results summary_spec summary_rows . str "\n\n" else id) - . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab) + . interleave "\n\n" (map (asciiGenProgTable results args norm) per_prog_result_tab) . str "\n" . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab) ) "\n" -asciiGenProgTable :: [ResultTable] -> [String] -> PerProgTableSpec -> ShowS -asciiGenProgTable results args (SpecP long_name _ _ get_result get_status result_ok) +asciiGenProgTable :: [ResultTable] -> [String] -> Normalise -> PerProgTableSpec -> ShowS +asciiGenProgTable results args norm (SpecP long_name _ _ get_result get_status result_ok) = str long_name . str "\n" - . ascii_show_results results args get_result get_status result_ok + . ascii_show_results results args get_result get_status result_ok norm asciiGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> ShowS asciiGenModTable results args (SpecM long_name _ get_result result_ok) @@ -430,11 +508,12 @@ ascii_show_results -> (Results -> Maybe a) -> (Results -> Status) -> (a -> Bool) + -> Normalise -> ShowS -ascii_show_results [] _ _ _ _ +ascii_show_results [] _ _ _ _ _ = error "ascii_show_results: Can't happen?" -ascii_show_results (r:rs) ss f stat result_ok +ascii_show_results (r:rs) ss f stat result_ok norm = ascii_header fIELD_WIDTH ss . interleave "\n" (map show_per_prog_results results_per_prog) . if nodevs then id @@ -446,7 +525,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) (Map.toList r) + results_per_prog = map (calc_result rs f stat result_ok (normalise norm)) (Map.toList r) results_per_run = transpose (map snd results_per_prog) (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) @@ -491,7 +570,7 @@ ascii_summary_table latex (r1:r2:_) specs mb_restrict -- 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 @@ -516,10 +595,10 @@ mungeForLaTeX = map transrow transchar c s = c:s table_layout :: Int -> Int -> Layout -table_layout n w = - (str . rjustify 15) : - (\s -> str (space 5) . str (rjustify w s)) : - replicate (n-1) (str . rjustify w) +table_layout n w boxes = foldr (.) id $ zipWith ($) fns boxes + where fns = (str . rjustify 15 . show ) : + (\s -> str (space 5) . str (rjustify w (show s))) : + replicate (n-1) (str . rjustify w . show) ascii_show_multi_results :: Result a @@ -559,7 +638,7 @@ ascii_show_multi_results (r:rs) ss f result_ok 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") @@ -582,6 +661,43 @@ show_per_prog_results_width w (prog,results) . str (space 5) . foldr (.) id (map (str . rjustify w . showBox) results) +-- ----------------------------------------------------------------------------- +-- CSV output + +csvTable :: [ResultTable] -> String -> Normalise -> 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 -> Normalise -> 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) + -> Normalise + -> 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) (normalise norm) + + result_line (prog,boxes) = interleave "," (str prog : map (str.showBox) boxes) + -- --------------------------------------------------------------------------- -- Generic stuff for results generation @@ -591,11 +707,12 @@ calc_result => [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 norm_fn (prog,base_r) = (prog, (just_result m_baseline base_stat : let @@ -606,10 +723,10 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = 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 @@ -618,9 +735,9 @@ calc_result rts get_maybe_a get_stat result_ok (prog,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 = norm_fn baseline a + ----------------------------------------------------------------------------- -- Calculating geometric means and standard deviations @@ -685,29 +802,26 @@ calc_minmax xs ----------------------------------------------------------------------------- -- 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 -- ----------------------------------------------------------------------------- @@ -751,31 +865,30 @@ data TableRow = TableRow [BoxValue] | TableLine -type Layout = [String -> ShowS] +type Layout = [BoxValue] -> ShowS makeTable :: Layout -> [TableRow] -> ShowS makeTable layout = interleave "\n" . map do_row - where do_row (TableRow boxes) = applyLayout layout boxes + where do_row (TableRow boxes) = layout boxes do_row TableLine = str (take 80 (repeat '-')) makeLatexTable :: [TableRow] -> ShowS makeLatexTable = foldr (.) id . map do_row where do_row (TableRow boxes) - = applyLayout latexTableLayout boxes . str "\\\\\n" + = latexTableLayout boxes . str "\\\\\n" do_row TableLine = str "\\hline\n" latexTableLayout :: Layout -latexTableLayout = box : repeat (box . (" & "++)) - where box s = str (foldr transchar "" s) +latexTableLayout boxes = + foldr (.) id . intersperse (str " & ") . map abox $ boxes + where + abox (RunFailed NotDone) = id + abox s = str (foldr transchar "" (show s)) transchar '%' s = s -- leave out the percentage signs transchar c s = c : s -applyLayout :: Layout -> [BoxValue] -> ShowS -applyLayout layout values = - foldr (.) id [ f (show val) | (val,f) <- zip values layout ] - -- ----------------------------------------------------------------------------- -- General Utils