import CmdLine
import Text.Printf
-import Text.Html hiding ((!))
+import Text.Html hiding (cols, rows, (!))
import qualified Text.Html as Html ((!))
import qualified Data.Map as Map
import Data.Map (Map)
import System.Console.GetOpt
import System.Exit ( exitWith, ExitCode(..) )
-import Numeric ( showFloat, showFFloat, showSigned )
+import Control.Monad
import Data.Maybe ( isNothing )
import Data.Char
import System.IO
die :: String -> IO a
die s = hPutStr stderr s >> exitWith (ExitFailure 1)
+usageHeader :: String
usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
+main :: IO ()
main = do
- if not (null cmdline_errors) || OptHelp `elem` flags
- then die (concat cmdline_errors ++ usageInfo usageHeader argInfo)
- else do
+ when (not (null cmdline_errors) || OptHelp `elem` flags) $
+ die (concat cmdline_errors ++ usageInfo usageHeader argInfo)
- let { html = OptHTMLOutput `elem` flags;
+ let { html = OptHTMLOutput `elem` flags;
latex = OptLaTeXOutput `elem` flags;
ascii = OptASCIIOutput `elem` flags
}
- if ascii && html
- then die "Can't produce both ASCII and HTML"
- else do
-
- if devs && nodevs
- then die "Can't both display and hide deviations"
- else do
+ when (ascii && html) $ die "Can't produce both ASCII and HTML"
+ when (devs && nodevs) $ die "Can't both display and hide deviations"
results <- parse_logs other_args
let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
-- sanity check
- sequence_ [ checkTimes prog res | table <- results,
- (prog,res) <- Map.toList table ]
+ sequence_ [ checkTimes prog res | result_table <- results,
+ (prog,res) <- Map.toList result_table ]
case () of
- _ | html ->
+ _ | html ->
putStr (renderHtml (htmlPage results column_headings))
- _ | latex ->
+ _ | latex ->
putStr (latexOutput results column_headings summary_spec summary_rows)
- _ | otherwise ->
+ _ | otherwise ->
putStr (asciiPage results column_headings summary_spec summary_rows)
data PerProgTableSpec =
forall a . Result a =>
- SpecP
+ SpecP
String -- Name of the table
String -- Short name (for column heading)
String -- HTML tag for the table
data PerModuleTableSpec =
forall a . Result a =>
- SpecM
+ SpecM
String -- Name of the table
String -- HTML tag for the table
(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.
+size_spec, alloc_spec, runtime_spec, muttime_spec, gctime_spec,
+ gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_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
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 :: [PerProgTableSpec]
all_specs = [
size_spec,
alloc_spec,
namedColumns :: [String] -> IO [PerProgTableSpec]
namedColumns ss = mapM findSpec ss
- where findSpec s =
+ where findSpec s =
case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
short_name == s ] of
[] -> die ("unknown column: " ++ s)
check "GC time" (gc_time results)
where
check kind ts
- | any strange ts =
+ | any strange ts =
hPutStrLn stderr ("warning: dubious " ++ kind
++ " results for " ++ prog
++ ": " ++ show ts)
-- 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 ]
-- 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 ]
-
+
+cachegrind_summary_specs :: [PerProgTableSpec]
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
+pickSummary rs
| isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
| otherwise = cachegrind_summary_specs
+per_module_result_tab :: [PerModuleTableSpec]
per_module_result_tab =
[ SpecM "Module Sizes" "mod-sizes" module_size always_ok
, SpecM "Compile Times" "compile-time" compile_time time_ok
-----------------------------------------------------------------------------
-- HTML page generation
---htmlPage :: Results -> [String] -> Html
+htmlPage :: [ResultTable] -> [String] -> Html
htmlPage results args
= header << thetitle << reportTitle
+++ hr
+++ hr
htmlGenModTable results args (SpecM title anc get_result result_ok)
- = sectHeading title anc
- +++ font <![size "1"]
+ = sectHeading title anc
+ +++ font <![size "1"]
<< mkTable (htmlShowMultiResults results args get_result result_ok)
+++ hr
sectHeading :: String -> String -> Html
sectHeading s nm = h2 << anchor <! [name nm] << s
-htmlShowResults
+htmlShowResults
:: Result a
=> [ResultTable]
-> [String]
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
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)
-> HtmlTable
htmlShowMultiResults (r:rs) ss f result_ok =
- multiTabHeader ss
+ multiTabHeader ss
</> aboves (map show_results_for_prog results_per_prog_mod_run)
</> aboves ((if nodevs then []
else [td << bold << "-1 s.d."
tableRow :: Int -> (String, [BoxValue]) -> HtmlTable
tableRow row_no (prog, results)
= td <! [bgcolor left_column_color] << prog
- <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
+ <-> besides (map (\s -> td <! [align "right", clr] << showBox s)
results)
where clr | row_no < 0 = bgcolor average_row_color
| even row_no = bgcolor even_row_color
mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
tabHeader ss
- = (td <! [align "left", width "100"] << bold << "Program")
+ = (td <! [align "left", width "100"] << bold << "Program")
<-> logHeaders ss
multiTabHeader ss
) "\n"
asciiGenProgTable results args (SpecP title _ anc get_result get_status result_ok)
- = str title
+ = str title
. 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
+ = str title
. str "\n"
. ascii_show_multi_results results args get_result result_ok
where
-- results_per_prog :: [ (String,[BoxValue a]) ]
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)
-- 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
+ascii_summary_table
:: Bool -- generate a LaTeX table?
-> [ResultTable]
-> [PerProgTableSpec]
-> ShowS
ascii_summary_table latex (r1:r2:_) specs mb_restrict
| latex = makeLatexTable (rows ++ TableLine : av_rows)
- | otherwise =
+ | otherwise =
makeTable (table_layout (length specs) width)
(TableLine : TableRow header : TableLine : rows ++ TableLine : av_rows)
where
transchar c s = c:s
table_layout n width =
- (str . rjustify 15) :
+ (str . rjustify 15) :
(\s -> str (space 5) . str (rjustify width s)) :
replicate (n-1) (str . rjustify width)
-> ShowS
ascii_show_multi_results (r:rs) ss f result_ok
- = ascii_header fIELD_WIDTH ss
+ = ascii_header fIELD_WIDTH ss
. interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
. str "\n"
. if nodevs then id
-- Generic stuff for results generation
-- calc_result is a nice exercise in higher-order programming...
-calc_result
+calc_result
:: Result a
=> [Map String b] -- accumulated results
-> (b -> Maybe a) -- get a result from the b
just_result (Just a) s = toBox a
percentage Nothing s base = RunFailed s
- percentage (Just a) s base = Percentage
+ percentage (Just a) s base = Percentage
(convert_to_percentage base a)
-----------------------------------------------------------------------------
-- Calculating geometric means and standard deviations
{-
This is done using the log method, to avoid needing really large
-intermediate results. The formula for a geometric mean is
+intermediate results. The formula for a geometric mean is
(a1 * .... * an) ^ 1/n
-}
calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
-calc_gmsd xs
+calc_gmsd xs
| null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
| otherwise = let sqr x = x * x
len = fromIntegral (length percentages)
calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
calc_minmax xs
| null percentages = (RunFailed NotDone, RunFailed NotDone)
- | otherwise = (Percentage (minimum percentages),
+ | otherwise = (Percentage (minimum percentages),
Percentage (maximum percentages))
where
percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
transchar c s = c : s
applyLayout :: Layout -> [BoxValue] -> ShowS
-applyLayout layout values =
+applyLayout layout values =
foldr (.) id [ f (show val) | (val,f) <- zip values layout ]
-- -----------------------------------------------------------------------------
split :: Char -> String -> [String]
split c s = case rest of
- [] -> [chunk]
+ [] -> [chunk]
_:rest -> chunk : split c rest
where (chunk, rest) = break (==c) s
str = showString
-interleave s = foldr1 (\a b -> a . str s . b)
+interleave s = foldr1 (\a b -> a . str s . b)
fIELD_WIDTH = 16 :: Int
projects / ghc-hetmet.git / blobdiff