X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fnofib-analyse%2FMain.hs;h=456747fd9e4049053f6583bd1cfc291dca0db962;hb=7eeac4d143e9287d7c2e27ba23b84d175df49962;hp=c0c2903a171c177197f50bae3d23cfff6205450d;hpb=aacb44f0de5a337171b1446cab3eaa73f978d480;p=ghc-hetmet.git diff --git a/utils/nofib-analyse/Main.hs b/utils/nofib-analyse/Main.hs index c0c2903..456747f 100644 --- a/utils/nofib-analyse/Main.hs +++ b/utils/nofib-analyse/Main.hs @@ -23,6 +23,7 @@ import Data.Char import System.IO import Data.List +( a -> [HtmlAttr] -> a ( + putStr (csvTable results (head csv) (not no_norm)) _ | html -> putStr (renderHtml (htmlPage results column_headings)) _ | latex -> @@ -101,14 +106,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, - 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 @@ -120,8 +135,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, @@ -164,14 +187,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, - 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 = @@ -209,24 +233,32 @@ htmlPage results args +++ hr +++ body (gen_tables results args) +gen_menu :: Html gen_menu = unordList (map (prog_menu_item) per_prog_result_tab - ++ map (module_menu_item) per_module_result_tab) + ++ map (module_menu_item) per_module_result_tab) -prog_menu_item (SpecP name _ anc _ _ _) = anchor Html +prog_menu_item (SpecP long_name _ anc _ _ _) + = anchor Html +module_menu_item (SpecM long_name anc _ _) + = anchor [String] -> Html gen_tables results args = - foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab) - +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab) + foldr1 (+++) (map (htmlGenProgTable results args) per_prog_result_tab) + +++ foldr1 (+++) (map (htmlGenModTable results args) per_module_result_tab) -htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok) - = sectHeading title anc +htmlGenProgTable :: [ResultTable] -> [String] -> PerProgTableSpec -> Html +htmlGenProgTable results args (SpecP long_name _ anc get_result get_status result_ok) + = sectHeading long_name anc +++ font [String] -> PerModuleTableSpec -> Html +htmlGenModTable results args (SpecM long_name anc get_result result_ok) + = sectHeading long_name anc +++ font (a -> Bool) -> HtmlTable +htmlShowResults [] _ _ _ _ + = error "htmlShowResults: Can't happen?" htmlShowResults (r:rs) ss f stat result_ok = tabHeader ss aboves (zipWith tableRow [1..] results_per_prog) @@ -252,7 +286,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) @@ -265,6 +299,8 @@ htmlShowMultiResults -> (a -> Bool) -> HtmlTable +htmlShowMultiResults [] _ _ _ + = error "htmlShowMultiResults: Can't happen?" htmlShowMultiResults (r:rs) ss f result_ok = multiTabHeader ss aboves (map show_results_for_prog results_per_prog_mod_run) @@ -275,7 +311,6 @@ htmlShowMultiResults (r:rs) ss f result_ok = <-> tableRow (-1) ("", highs)]) ++ [td << bold << "Average" <-> tableRow (-1) ("", gms)]) - where base_results = Map.toList r :: [(String,Results)] @@ -283,7 +318,8 @@ htmlShowMultiResults (r:rs) ss f result_ok = 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 (Map.toList (f r))) + get_results_for_prog (prog, results) + = (prog, map get_results_for_mod (Map.toList (f results))) where fms = map get_run_results rs @@ -291,8 +327,8 @@ htmlShowMultiResults (r:rs) ss f result_ok = Nothing -> Map.empty Just res -> f res - get_results_for_mod (id,attr) = calc_result fms Just (const Success) - result_ok (id,attr) + get_results_for_mod id_attr + = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr show_results_for_prog (prog,mrs) = td logHeaders ss -- Calculate a color ranging from bright blue for -100% to bright red for +100%. - calcColor :: Int -> String -calcColor p | p >= 0 = "#" ++ (showHex red 2 "0000") - | otherwise = "#0000" ++ (showHex blue 2 "") - where red = p * 255 `div` 100 - blue = (-p) * 255 `div` 100 - -showHex 0 f s = if f > 0 then take f (repeat '0') ++ s else s -showHex i f s = showHex (i `div` 16) (f-1) (hexDig (i `mod` 16) : s) - -hexDig i | i > 10 = chr (i-10 + ord 'a') - | otherwise = chr (i + ord '0') +calcColor percentage | percentage >= 0 = printf "#%02x0000" val + | otherwise = printf "#0000%02x" val + where val = abs percentage * 255 `div` 100 ----------------------------------------------------------------------------- -- LaTeX table generation (just the summary for now) -latexOutput results args summary_spec summary_rows = +latexOutput :: [ResultTable] -> [String] -> [PerProgTableSpec] + -> Maybe [String] -> String +latexOutput results _ summary_spec summary_rows = (if (length results == 2) then ascii_summary_table True results summary_spec summary_rows . str "\n\n" @@ -378,6 +409,8 @@ latexOutput results args summary_spec summary_rows = ----------------------------------------------------------------------------- -- ASCII page generation +asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String] + -> String asciiPage results args summary_spec summary_rows = ( str reportTitle . str "\n\n" @@ -390,21 +423,24 @@ asciiPage results args summary_spec summary_rows = . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab) ) "\n" -asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok) - = str title +asciiGenProgTable :: [ResultTable] -> [String] -> PerProgTableSpec -> ShowS +asciiGenProgTable results args (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 -asciiGenModTable results args (SpecM title anc get_result result_ok) - = str title +asciiGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> ShowS +asciiGenModTable results args (SpecM long_name _ get_result result_ok) + = str long_name . str "\n" . ascii_show_multi_results results args get_result result_ok -ascii_header width ss +ascii_header :: Int -> [String] -> ShowS +ascii_header w ss = str "\n-------------------------------------------------------------------------------\n" . str (rjustify 15 "Program") . str (space 5) - . foldr (.) id (map (str . rjustify width) ss) + . foldr (.) id (map (str . rjustify w) ss) . str "\n-------------------------------------------------------------------------------\n" ascii_show_results @@ -416,6 +452,8 @@ ascii_show_results -> (a -> Bool) -> ShowS +ascii_show_results [] _ _ _ _ + = error "ascii_show_results: Can't happen?" ascii_show_results (r:rs) ss f stat result_ok = ascii_header fIELD_WIDTH ss . interleave "\n" (map show_per_prog_results results_per_prog) @@ -428,7 +466,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 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) @@ -441,13 +479,19 @@ ascii_summary_table -> [PerProgTableSpec] -> Maybe [String] -> ShowS +ascii_summary_table _ [] _ _ + = error "ascii_summary_table: Can't happen?" +ascii_summary_table _ [_] _ _ + = error "ascii_summary_table: Can't happen?" ascii_summary_table latex (r1:r2:_) specs mb_restrict | latex = makeLatexTable (rows ++ TableLine : av_rows) | otherwise = - makeTable (table_layout (length specs) width) - (TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows) + makeTable (table_layout (length specs) w) + (TableLine : TableRow header_row : + TableLine : rows ++ + TableLine : av_rows) where - header = BoxString "Program" : map BoxString headings + header_row = BoxString "Program" : map BoxString headings (headings, columns, av_cols) = unzip3 (map calc_col specs) av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"] @@ -461,15 +505,16 @@ ascii_summary_table latex (r1:r2:_) specs mb_restrict | otherwise = rows1 av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols)) - width = 10 + w = 10 calc_col (SpecP _ heading _ getr gets ok) - = (heading, column, [min,max,mean]) -- throw away the baseline result + -- 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 - (_,mean,_) = calc_gmsd column - (min,max) = calc_minmax column + (_, column_mean, _) = calc_gmsd column + (column_min, column_max) = calc_minmax column restrictRows :: Maybe [String] -> [TableRow] -> [TableRow] restrictRows Nothing rows = rows @@ -490,10 +535,11 @@ mungeForLaTeX = map transrow transchar '_' s = '\\':'_':s transchar c s = c:s -table_layout n width = +table_layout :: Int -> Int -> Layout +table_layout n w = (str . rjustify 15) : - (\s -> str (space 5) . str (rjustify width s)) : - replicate (n-1) (str . rjustify width) + (\s -> str (space 5) . str (rjustify w s)) : + replicate (n-1) (str . rjustify w) ascii_show_multi_results :: Result a @@ -503,6 +549,8 @@ ascii_show_multi_results -> (a -> Bool) -> ShowS +ascii_show_multi_results [] _ _ _ + = error "ascii_show_multi_results: Can't happen?" ascii_show_multi_results (r:rs) ss f result_ok = ascii_header fIELD_WIDTH ss . interleave "\n" (map show_results_for_prog results_per_prog_mod_run) @@ -521,7 +569,8 @@ ascii_show_multi_results (r:rs) ss f result_ok 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 (Map.toList (f r))) + get_results_for_prog (prog, results) + = (prog, map get_results_for_mod (Map.toList (f results))) where fms = map get_run_results rs @@ -529,8 +578,8 @@ ascii_show_multi_results (r:rs) ss f result_ok Nothing -> Map.empty Just res -> f res - get_results_for_mod (id,attr) = calc_result fms Just (const Success) - result_ok (id,attr) + get_results_for_mod 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") @@ -547,10 +596,51 @@ ascii_show_multi_results (r:rs) ss f result_ok show_per_prog_results :: (String, [BoxValue]) -> ShowS show_per_prog_results = show_per_prog_results_width fIELD_WIDTH -show_per_prog_results_width width (prog,results) +show_per_prog_results_width :: Int -> (String, [BoxValue]) -> ShowS +show_per_prog_results_width w (prog,results) = str (rjustify 15 prog) . str (space 5) - . foldr (.) id (map (str . rjustify width . showBox) results) + . 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 @@ -561,12 +651,13 @@ 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) = - (prog, (just_result baseline base_stat : +calc_result rts get_maybe_a get_stat base_ok normalise (prog,base_r) = + (prog, (just_result m_baseline base_stat : let rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts @@ -575,22 +666,22 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = get_stuff (Just r) = (get_maybe_a r, get_stat r) in ( - case baseline of - Just base | result_ok base - -> map (\(r,s) -> percentage r s base) rts' - _other - -> map (\(r,s) -> just_result r s) rts' + case m_baseline of + Just baseline | base_ok baseline + -> map (\(r,s) -> do_norm r s baseline) rts' + _other + -> map (\(r,s) -> just_result r s) rts' ))) where - baseline = get_maybe_a base_r + m_baseline = get_maybe_a base_r base_stat = get_stat base_r just_result Nothing s = RunFailed s just_result (Just a) _ = toBox a - percentage Nothing s _ = RunFailed s - percentage (Just a) _ base = Percentage - (convert_to_percentage base a) + do_norm Nothing s _ = RunFailed s + do_norm (Just a) _ baseline = normalise baseline a + ----------------------------------------------------------------------------- -- Calculating geometric means and standard deviations @@ -626,14 +717,14 @@ We therefore return a (low, mean, high) triple. calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue) calc_gmsd xs | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone) - | otherwise = let sqr x = x * x - len = fromIntegral (length percentages) - logs = map log percentages - lbar = sum logs / len - devs = map (sqr . (lbar-)) logs - dbar = sum devs / len - gm = exp lbar - sdf = exp (sqrt dbar) + | otherwise = let sqr x = x * x + len = fromIntegral (length percentages) + logs = map log percentages + lbar = sum logs / len + st_devs = map (sqr . (lbar-)) logs + dbar = sum st_devs / len + gm = exp lbar + sdf = exp (sqrt dbar) in (Percentage (gm/sdf), Percentage gm, @@ -655,29 +746,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 base size - = (fromIntegral size / fromIntegral base) * 100 - toBox = BoxInt instance Result Integer where - convert_to_percentage 0 _ = 100 - convert_to_percentage base size - = (fromInteger size / fromInteger base) * 100 toBox = BoxInteger instance Result Float where - convert_to_percentage 0.0 _ = 100.0 - convert_to_percentage base size = size / base * 100 - toBox = BoxFloat -- ----------------------------------------------------------------------------- @@ -694,7 +782,9 @@ data BoxValue showBox :: BoxValue -> String showBox (RunFailed stat) = show_stat stat -showBox (Percentage f) = printf "%+.1f%%" (f-100) +showBox (Percentage f) = case printf "%.1f%%" (f-100) of + xs@('-':_) -> xs + xs -> '+':xs showBox (BoxFloat f) = printf "%.2f" f showBox (BoxInt n) = show (n `div` 1024) ++ "k" showBox (BoxInteger n) = show (n `div` 1024) ++ "k" @@ -722,8 +812,8 @@ data TableRow type Layout = [String -> ShowS] makeTable :: Layout -> [TableRow] -> ShowS -makeTable p = interleave "\n" . map do_row - where do_row (TableRow boxes) = applyLayout p boxes +makeTable layout = interleave "\n" . map do_row + where do_row (TableRow boxes) = applyLayout layout boxes do_row TableLine = str (take 80 (repeat '-')) makeLatexTable :: [TableRow] -> ShowS @@ -748,15 +838,19 @@ applyLayout layout values = -- General Utils split :: Char -> String -> [String] -split c s = case rest of - [] -> [chunk] - _:rest -> chunk : split c rest - where (chunk, rest) = break (==c) s +split c s = case break (==c) s of + (chunk, rest) -> + case rest of + [] -> [chunk] + _:rest' -> chunk : split c rest' +str :: String -> ShowS str = showString +interleave :: String -> [ShowS] -> ShowS interleave s = foldr1 (\a b -> a . str s . b) -fIELD_WIDTH = 16 :: Int +fIELD_WIDTH :: Int +fIELD_WIDTH = 16 -----------------------------------------------------------------------------