X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=glafp-utils%2Fnofib-analyse%2FMain.hs;h=c2b0d42ad0cc67a7d3707f3cce3b2ba414c8540d;hb=a106bbffa1188d62bb86e357714bbe4acdecd37e;hp=ad1a7ab88afb90f54d32ca2c8b34b57ad62bad62;hpb=b7081c5f00ef3947dbb39f942b4c5edaf524b3b5;p=ghc-hetmet.git diff --git a/glafp-utils/nofib-analyse/Main.hs b/glafp-utils/nofib-analyse/Main.hs index ad1a7ab..c2b0d42 100644 --- a/glafp-utils/nofib-analyse/Main.hs +++ b/glafp-utils/nofib-analyse/Main.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.1 1999/11/12 11:54:17 simonmar Exp $ +-- $Id: Main.hs,v 1.10 2005/06/07 10:58:31 simonmar Exp $ --- (c) Simon Marlow 1997-1999 +-- (c) Simon Marlow 1997-2005 ----------------------------------------------------------------------------- module Main where @@ -9,18 +9,20 @@ module Main where import GenUtils import Printf import Slurp -import DataHtml import CmdLine -import GlaExts -import FiniteMap -import GetOpt +import Text.Html hiding ((!)) +import qualified Text.Html as Html ((!)) +import Data.FiniteMap +import System.Console.GetOpt +import System.Exit ( exitWith, ExitCode(..) ) -import Char -import IO -import Array -import System -import List +import Data.Maybe ( isNothing ) +import Data.Char +import System.IO +import Data.List + +( return (pickSummary results) + (cols:_) -> namedColumns (split ',' cols) + + let summary_rows = case [ rows | OptRows rows <- flags ] of + [] -> Nothing + rows -> Just (split ',' (last rows)) + let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args - if html - then putStr (renderHtml (htmlPage results column_headings)) - else putStr (asciiPage results column_headings) + -- sanity check + sequence_ [ checkTimes prog res | table <- results, + (prog,res) <- fmToList table ] + + case () of + _ | html -> + putStr (renderHtml (htmlPage results column_headings)) + _ | latex -> + putStr (latexOutput results column_headings summary_spec summary_rows) + _ | otherwise -> + putStr (asciiPage results column_headings summary_spec summary_rows) parse_logs :: [String] -> IO [ResultTable] @@ -69,6 +92,7 @@ data PerProgTableSpec = forall a . Result a => SpecP String -- Name of the table + String -- Short name (for column heading) String -- HTML tag for the table (Results -> Maybe a) -- How to get the result (Results -> Status) -- How to get the status of this result @@ -82,17 +106,83 @@ data PerModuleTableSpec = (Results -> FiniteMap 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. +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 +muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status time_ok +gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) 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 +mwrite_spec = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok +cmiss_spec = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok + +all_specs = [ + size_spec, + alloc_spec, + runtime_spec, + muttime_spec, + gctime_spec, + gcwork_spec, + instrs_spec, + mreads_spec, + mwrite_spec, + cmiss_spec + ] + +namedColumns :: [String] -> IO [PerProgTableSpec] +namedColumns ss = mapM findSpec ss + where findSpec s = + case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs, + short_name == s ] of + [] -> die ("unknown column: " ++ s) + (spec:_) -> return spec + +mean :: (Results -> [Float]) -> Results -> Maybe Float +mean f results = go (f results) + where go [] = Nothing + go fs = Just (foldl' (+) 0 fs / fromIntegral (length fs)) + +-- Look for bogus-looking times: On Linux we occasionally get timing results +-- that are bizarrely low, and skew the average. +checkTimes :: String -> Results -> IO () +checkTimes prog results = do + check "run time" (run_time results) + check "mut time" (mut_time results) + check "GC time" (gc_time results) + where + check kind ts + | any strange ts = + hPutStrLn stderr ("warning: dubious " ++ kind + ++ " results for " ++ prog + ++ ": " ++ show ts) + | otherwise = return () + where strange t = any (\r -> time_ok r && r / t > 1.4) ts + -- looks for times that are >40% smaller than + -- any other. + + +-- These are the per-prog tables we want to generate per_prog_result_tab = - [ SpecP "Binary Sizes" "binary-sizes" binary_size compile_status always_ok - , SpecP "Allocations" "allocations" allocs run_status always_ok - , SpecP "Run Time" "run-times" run_time run_status time_ok - , SpecP "Mutator Time" "mutator-time" mut_time run_status time_ok - , SpecP "GC Time" "gc-time" gc_time run_status time_ok - , SpecP "GC Work" "gc-work" gc_work run_status always_ok - , SpecP "Instructions" "instrs" instrs run_status always_ok - , SpecP "Memory Reads" "mem-reads" mem_reads run_status always_ok - , SpecP "Memory Writes" "mem-writes" mem_writes run_status always_ok - ] + [ size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec, + gcwork_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 = + [ size_spec, alloc_spec, runtime_spec ] + +cachegrind_summary_specs = + [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ] + +-- Pick an appropriate summary table: if we're cachegrinding, then +-- we're probably not interested in the runtime, but we are interested +-- in instructions, mem reads and mem writes (and vice-versa). +pickSummary :: [ResultTable] -> [PerProgTableSpec] +pickSummary rs + | isNothing (instrs (head (eltsFM (head rs)))) = normal_summary_specs + | otherwise = cachegrind_summary_specs per_module_result_tab = [ SpecM "Module Sizes" "mod-sizes" module_size always_ok @@ -108,39 +198,39 @@ time_ok t = t > tooquick_threshold ----------------------------------------------------------------------------- -- HTML page generation +--htmlPage :: Results -> [String] -> Html htmlPage results args - = header [] (theTitle [] (htmlStr "NoFib Results")) - +++ bar [] + = header << thetitle << reportTitle + +++ hr + +++ h1 << reportTitle +++ gen_menu - +++ bar [] - +++ body [] (gen_tables results args) + +++ hr + +++ body (gen_tables results args) -gen_menu = ul [] (foldr1 (+++) (map (li [] +++) - (map (prog_menu_item) per_prog_result_tab - ++ map (module_menu_item) per_module_result_tab))) +gen_menu = unordList (map (prog_menu_item) per_prog_result_tab + ++ map (module_menu_item) per_module_result_tab) -prog_menu_item (SpecP name anc _ _ _) = anchor [href ('#':anc)] (htmlStr name) -module_menu_item (SpecM name anc _ _) = anchor [href ('#':anc)] (htmlStr name) +prog_menu_item (SpecP name _ anc _ _ _) = anchor String -> Html -sectHeading s nm - = h2 [] (anchor [name nm] (htmlStr s)) +sectHeading s nm = h2 << anchor aboves (zipWith tableRow [1..] results_per_prog) + aboves ((if nodevs then [] + else [tableRow (-1) ("-1 s.d.", lows), + tableRow (-1) ("+1 s.d.", highs)]) + ++ [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_run = transpose (map snd results_per_prog) - geometric_means = map calc_gm results_per_run + results_per_run = transpose (map snd results_per_prog) + (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) htmlShowMultiResults :: Result a @@ -172,37 +265,49 @@ htmlShowMultiResults htmlShowMultiResults (r:rs) ss f result_ok = multiTabHeader ss - +/+ foldr1 (+/+) (map show_results_for_prog base_results) + aboves (map show_results_for_prog results_per_prog_mod_run) + aboves ((if nodevs then [] + else [td << bold << "-1 s.d." + <-> tableRow (-1) ("", lows), + td << bold << "+1 s.d." + <-> tableRow (-1) ("", highs)]) + ++ [td << bold << "Average" + <-> tableRow (-1) ("", gms)]) where base_results = fmToList r :: [(String,Results)] - show_results_for_prog (prog,r) = - cellHtml [valign "top"] (bold [] (htmlStr prog)) - +-+ (if null base then - cellHtml [] (htmlStr "(no modules compiled)") - else - foldr1 (+/+) (map (show_one_result fms) base)) + -- 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))) - where - base = fmToList (f r) - fms = map (get_results_for prog) rs + where fms = map get_run_results rs - get_results_for prog m = case lookupFM m prog of - Nothing -> emptyFM - Just r -> f r + get_run_results fm = case lookupFM fm prog of + Nothing -> emptyFM + Just res -> f res - show_one_result other_results (id,attribute) = - tableRow 0 ( - calc_result other_results Just (const Success) - result_ok (id,attribute) - ) + get_results_for_mod (id,attr) = calc_result fms Just (const Success) + result_ok (id,attr) -tableRow :: Result a => Int -> (String, [BoxValue a]) -> HtmlTable + show_results_for_prog (prog,mrs) = + td (if null mrs then + td << "(no modules compiled)" + else + toHtml (aboves (map (tableRow 0) mrs))) + + results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run, + (_,xs) <- mods] + (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) + +tableRow :: Int -> (String, [BoxValue]) -> HtmlTable tableRow row_no (prog, results) - = cellHtml [bgcolor left_column_color] (htmlStr prog) - +-+ foldr1 (+-+) (map (cellHtml [align "right", clr] - . htmlStr . show_box) results) + = td besides (map (\s -> td cellHtml [align "right", width "100"] - (bold [] (htmlStr s))) ss) + = besides (map (\s -> (td Html -mkTable = renderTable [cellspacing 0, cellpadding 0, border 0] +mkTable t = table logHeaders ss multiTabHeader ss - = cellHtml [align "left", width "100"] (bold [] (htmlStr "Program")) - +-+ cellHtml [align "left", width "100"] (bold [] (htmlStr "Module")) - +-+ logHeaders ss + = (td (td logHeaders ss -- Calculate a color ranging from bright blue for -100% to bright red for +100%. @@ -257,15 +360,31 @@ hexDig i | i > 10 = chr (i-10 + ord 'a') | otherwise = chr (i + ord '0') ----------------------------------------------------------------------------- +-- LaTeX table generation (just the summary for now) + +latexOutput results args summary_spec summary_rows = + (if (length results == 2) + then ascii_summary_table True results summary_spec summary_rows + . str "\n\n" + else id) "" + + +----------------------------------------------------------------------------- -- ASCII page generation -asciiPage results args = - ( interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab) +asciiPage results args summary_spec summary_rows = + ( 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) . str "\n" . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab) ) "\n" -asciiGenProgTable results args (SpecP title anc get_result get_status result_ok) +asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok) = str title . str "\n" . ascii_show_results results args get_result get_status result_ok @@ -275,11 +394,11 @@ asciiGenModTable results args (SpecM title anc get_result result_ok) . str "\n" . ascii_show_multi_results results args get_result result_ok -ascii_header ss +ascii_header width ss = str "\n-------------------------------------------------------------------------------\n" . str (rjustify 15 "Program") . str (space 5) - . foldr (.) id (map (str . rjustify fIELD_WIDTH) ss) + . foldr (.) id (map (str . rjustify width) ss) . str "\n-------------------------------------------------------------------------------\n" ascii_show_results @@ -292,16 +411,83 @@ ascii_show_results -> ShowS ascii_show_results (r:rs) ss f stat result_ok - = ascii_header ss + = ascii_header fIELD_WIDTH ss . interleave "\n" (map show_per_prog_results results_per_prog) + . if nodevs then id + else str "\n" + . show_per_prog_results ("-1 s.d.",lows) + . str "\n" + . show_per_prog_results ("+1 s.d.",highs) . str "\n" - . show_per_prog_results ("Average",geometric_means) + . 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_run = transpose (map snd results_per_prog) - geometric_means = map calc_gm results_per_run + results_per_run = transpose (map snd results_per_prog) + (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) + +-- A summary table, useful only when we are comparing two runs. This table +-- shows a number of different result categories, one per column. +ascii_summary_table + :: Bool -- generate a LaTeX table? + -> [ResultTable] + -> [PerProgTableSpec] + -> Maybe [String] + -> ShowS +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) + where + header = BoxString "Program" : map BoxString headings + + (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) + rows0 = map TableRow (zipWith (:) progs (transpose columns)) + + rows1 = restrictRows mb_restrict rows0 + + rows | latex = mungeForLaTeX rows1 + | otherwise = rows1 + + av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols)) + width = 10 + + calc_col (SpecP _ heading _ getr gets ok) + = (heading, column, [min,max,mean]) -- throw away the baseline result + where (_, boxes) = unzip (map calc_one_result baseline) + calc_one_result = calc_result [r2] getr gets ok + column = map (\(_:b:_) -> b) boxes + (_,mean,_) = calc_gmsd column + (min,max) = calc_minmax column + +restrictRows :: Maybe [String] -> [TableRow] -> [TableRow] +restrictRows Nothing rows = rows +restrictRows (Just these) rows = filter keep_it rows + where keep_it (TableRow (BoxString s: _)) = s `elem` these + keep_it TableLine = True + keep_it _ = False + +mungeForLaTeX :: [TableRow] -> [TableRow] +mungeForLaTeX = map transrow + where + transrow (TableRow boxes) = TableRow (map transbox boxes) + transrow row = row + + transbox (BoxString s) = BoxString (foldr transchar "" s) + transbox box = box + + transchar '_' s = '\\':'_':s + transchar c s = c:s + +table_layout n width = + (str . rjustify 15) : + (\s -> str (space 5) . str (rjustify width s)) : + replicate (n-1) (str . rjustify width) ascii_show_multi_results :: Result a @@ -312,66 +498,56 @@ ascii_show_multi_results -> ShowS ascii_show_multi_results (r:rs) ss f result_ok - = ascii_header ss - . interleave "\n" (map show_results_for_prog base_results) + = ascii_header fIELD_WIDTH ss + . interleave "\n" (map show_results_for_prog results_per_prog_mod_run) + . str "\n" + . if nodevs then id + else str "\n" + . show_per_prog_results ("-1 s.d.",lows) + . str "\n" + . show_per_prog_results ("+1 s.d.",highs) + . str "\n" + . show_per_prog_results ("Average",gms) where base_results = fmToList r :: [(String,Results)] - show_results_for_prog (prog,r) = - str ("\n"++prog++"\n") - . (if null base then - str "(no modules compiled)\n" - else - interleave "\n" (map (show_one_result fms) base)) - - where - base = fmToList (f r) - fms = map (get_results_for prog) rs - - get_results_for prog m = case lookupFM m prog of - Nothing -> emptyFM - Just r -> f r - - show_one_result other_results (id,attribute) = - show_per_prog_results ( - calc_result other_results Just (const Success) - result_ok (id,attribute) - ) - -show_per_prog_results :: Result a => (String, [BoxValue a]) -> ShowS -show_per_prog_results (prog,results) - = str (rjustify 15 prog) - . str (space 5) - . foldr (.) id (map (str . rjustify fIELD_WIDTH . show_box) results) + -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])] + results_per_prog_mod_run = map get_results_for_prog base_results ------------------------------------------------------------------------------ --- Show the 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))) -class Num a => Result a where - result_to_string :: a -> String - convert_to_percentage :: a -> a -> Float + where fms = map get_run_results rs --- We assume an Int is a size, and print it in kilobytes. + get_run_results fm = case lookupFM fm prog of + Nothing -> emptyFM + Just res -> f res -instance Result Int where - convert_to_percentage 0 size = 100 - convert_to_percentage base size = (fromInt size / fromInt base) * 100 + get_results_for_mod (id,attr) = calc_result fms Just (const Success) + result_ok (id,attr) - result_to_string n = show (n `div` 1024) ++ "k" + show_results_for_prog (prog,mrs) = + str ("\n"++prog++"\n") + . (if null mrs then + str "(no modules compiled)\n" + else + interleave "\n" (map show_per_prog_results mrs)) -instance Result Integer where - convert_to_percentage 0 size = 100 - convert_to_percentage base size = (fromInteger size / fromInteger base) * 100 + results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run, + (_,xs) <- mods] + (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run) - result_to_string n = show (n `quot` 1024) ++ "k" -instance Result Float where - convert_to_percentage 0.0 size = 100.0 - convert_to_percentage base size = size / base * 100 +show_per_prog_results :: (String, [BoxValue]) -> ShowS +show_per_prog_results = show_per_prog_results_width fIELD_WIDTH - result_to_string = showFloat' Nothing (Just 2) +show_per_prog_results_width width (prog,results) + = str (rjustify 15 prog) + . str (space 5) + . foldr (.) id (map (str . rjustify width . showBox) results) -data BoxValue a = RunFailed Status | Percentage Float | Result a +-- --------------------------------------------------------------------------- +-- Generic stuff for results generation -- calc_result is a nice exercise in higher-order programming... calc_result @@ -381,7 +557,7 @@ calc_result -> (b -> Status) -- get a status from the b -> (a -> Bool) -- is this result ok? -> (String,b) -- the baseline result - -> (String,[BoxValue a]) + -> (String,[BoxValue]) calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = (prog, (just_result baseline base_stat : @@ -404,17 +580,13 @@ calc_result rts get_maybe_a get_stat result_ok (prog,base_r) = base_stat = get_stat base_r just_result Nothing s = RunFailed s - just_result (Just a) s = Result a + just_result (Just a) s = toBox a percentage Nothing s base = RunFailed s percentage (Just a) s base = Percentage (convert_to_percentage base a) -show_box (RunFailed s) = show_stat s -show_box (Percentage p) = show_pcntage p -show_box (Result a) = result_to_string a - ----------------------------------------------------------------------------- --- Calculating geometric means +-- Calculating geometric means and standard deviations {- This is done using the log method, to avoid needing really large @@ -427,23 +599,105 @@ which is equivalent to e ^ ( (log a1 + ... + log an) / n ) where log is the natural logarithm function. + +Similarly, to compute the geometric standard deviation we compute the +deviation of each log, take the root-mean-square, and take the +exponential again: + + e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n ) + +where lbar is the mean log, + + (log a1 + ... + log an) / n + +This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do +not subtract 100 from gm before performing this calculation. + +We therefore return a (low, mean, high) triple. + -} -calc_gm :: [BoxValue a] -> BoxValue Float -calc_gm xs - | null percentages = RunFailed NotDone - | otherwise = Percentage (exp (sum (map log percentages) / - fromInt (length percentages))) +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) + in + (Percentage (gm/sdf), + Percentage gm, + Percentage (gm*sdf)) where - percentages = [ f | Percentage f <- xs, f /= 0.0 ] + percentages = [ if f < 5 then 5 else f | Percentage f <- xs ] -- can't do log(0.0), so exclude zeros + -- small values have inordinate effects so cap at -95%. + +calc_minmax :: [BoxValue] -> (BoxValue, BoxValue) +calc_minmax xs + | null percentages = (RunFailed NotDone, RunFailed NotDone) + | otherwise = (Percentage (minimum percentages), + Percentage (maximum percentages)) + where + percentages = [ if f < 5 then 5 else f | Percentage f <- xs ] + ----------------------------------------------------------------------------- --- Generic stuff for results generation +-- Show the Results + +class Num 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 size = 100 + convert_to_percentage base size = (fromIntegral size / fromIntegral base) * 100 + + toBox = BoxInt + +instance Result Integer where + convert_to_percentage 0 size = 100 + convert_to_percentage base size = (fromInteger size / fromInteger base) * 100 + toBox = BoxInteger + + +instance Result Float where + convert_to_percentage 0.0 size = 100.0 + convert_to_percentage base size = size / base * 100 + + toBox = BoxFloat + +-- ----------------------------------------------------------------------------- +-- BoxValues + +-- The contents of a box in a table +data BoxValue + = RunFailed Status + | Percentage Float + | BoxFloat Float + | BoxInt Int + | BoxInteger Integer + | BoxString String + +showBox :: BoxValue -> String +showBox (RunFailed stat) = show_stat stat +showBox (Percentage f) = show_pcntage f +showBox (BoxFloat f) = showFloat' Nothing (Just 2) 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 = show_float_signed (n-100) ++ "%" -show_float_signed = showFloat False False True False False Nothing (Just 2) +show_float_signed = showFloat False False True False False Nothing (Just 1) show_stat Success = "(no result)" show_stat WrongStdout = "(stdout)" @@ -453,6 +707,47 @@ show_stat OutOfHeap = "(heap)" show_stat OutOfStack = "(stack)" show_stat NotDone = "-----" +-- ----------------------------------------------------------------------------- +-- Table layout + +data TableRow + = TableRow [BoxValue] + | TableLine + +type Layout = [String -> ShowS] + +makeTable :: Layout -> [TableRow] -> ShowS +makeTable p = interleave "\n" . map do_row + where do_row (TableRow boxes) = applyLayout p 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" + do_row TableLine + = str "\\hline\n" + +latexTableLayout :: Layout +latexTableLayout = box : repeat (box . (" & "++)) + where box s = str (foldr transchar "" 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 + +split :: Char -> String -> [String] +split c s = case rest of + [] -> [chunk] + _:rest -> chunk : split c rest + where (chunk, rest) = break (==c) s + str = showString interleave s = foldr1 (\a b -> a . str s . b)