add Outputable instance for OccIfaceEq

[ghc-hetmet.git] / utils / nofib-analyse / Main.hs

diff --git a/utils/nofib-analyse/Main.hs b/utils/nofib-analyse/Main.hs
index af2c928..9e8088b 100644 (file)
--- a/utils/nofib-analyse/Main.hs
+++ b/utils/nofib-analyse/Main.hs
@@ -11,19 +11,19 @@ import Slurp
 import CmdLine
 
 import Text.Printf
 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 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 System.Exit      ( exitWith, ExitCode(..) )
 

-import Numeric          ( showFloat, showFFloat, showSigned )
+import Control.Monad

 import Data.Maybe       ( isNothing )
 import Data.Char
 import System.IO
 import Data.List
 
 import Data.Maybe       ( isNothing )
 import Data.Char
 import System.IO
 import Data.List
 

+(<!) :: Text.Html.ADDATTRS a => a -> [HtmlAttr] -> a

 (<!) = (Html.!)
 
 -----------------------------------------------------------------------------
 (<!) = (Html.!)
 
 -----------------------------------------------------------------------------

@@ -32,26 +32,19 @@ import Data.List
 die :: String -> IO a
 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
 
 die :: String -> IO a
 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
 

-usageHeader = "usage: nofib-analyse [OPTION...] <logfile1> <logfile2> ..."
-
+main :: IO ()

 main = do
 
 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 ++ usage)

 
  let { html  = OptHTMLOutput  `elem` flags;
        latex = OptLaTeXOutput `elem` flags;
        ascii = OptASCIIOutput `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
 
 
  results <- parse_logs other_args
 

@@ -66,8 +59,8 @@ main = do
  let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
 
  -- sanity check
  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      ->
 
  case () of
    _ | html      ->

@@ -109,6 +102,9 @@ data PerModuleTableSpec =
                 (a -> Bool)             -- Result within reasonable limits?
 
 -- The various per-program aspects of execution that we can generate results for.
                 (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
 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

@@ -120,6 +116,7 @@ mreads_spec  = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status alw
 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
 
 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,
 all_specs = [
   size_spec,
   alloc_spec,

@@ -166,15 +163,18 @@ checkTimes prog results = do
 
 
 -- These are the per-prog tables we want to generate
 
 
 -- 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.
 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 ]
 
 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 ]
 
 cachegrind_summary_specs =
         [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
 

@@ -186,6 +186,7 @@ pickSummary rs
   | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
   | otherwise = cachegrind_summary_specs
 
   | 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
 per_module_result_tab =
         [ SpecM "Module Sizes"  "mod-sizes"     module_size  always_ok
         , SpecM "Compile Times" "compile-time"  compile_time time_ok

@@ -200,7 +201,7 @@ time_ok t = t > tooquick_threshold
 -----------------------------------------------------------------------------
 -- HTML page generation
 
 -----------------------------------------------------------------------------
 -- HTML page generation
 

---htmlPage :: Results -> [String] -> Html
+htmlPage :: [ResultTable] -> [String] -> Html

 htmlPage results args
    =  header << thetitle << reportTitle
           +++ hr
 htmlPage results args
    =  header << thetitle << reportTitle
           +++ hr

@@ -209,24 +210,32 @@ htmlPage results args
           +++ hr
           +++ body (gen_tables results args)
 
           +++ hr
           +++ body (gen_tables results args)
 

+gen_menu :: Html

 gen_menu = unordList (map (prog_menu_item) per_prog_result_tab
 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 <! [href ('#':anc)] << name
-module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
+prog_menu_item :: PerProgTableSpec -> Html
+prog_menu_item (SpecP long_name _ anc _ _ _)
+    = anchor <! [href ('#':anc)] << long_name
+module_menu_item :: PerModuleTableSpec -> Html
+module_menu_item (SpecM long_name anc _ _)
+    = anchor <! [href ('#':anc)] << long_name

 
 

+gen_tables :: [ResultTable] -> [String] -> Html

 gen_tables results args =
 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 <! [size "1"]
         << mkTable (htmlShowResults results args get_result get_status result_ok)
   +++ hr
 
   +++ font <! [size "1"]
         << mkTable (htmlShowResults results args get_result get_status result_ok)
   +++ hr
 

-htmlGenModTable results args (SpecM title anc get_result result_ok)
-  =   sectHeading title anc
+htmlGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> Html
+htmlGenModTable results args (SpecM long_name anc get_result result_ok)
+  =   sectHeading long_name anc

   +++ font <![size "1"]
         << mkTable (htmlShowMultiResults results args get_result result_ok)
   +++ hr
   +++ font <![size "1"]
         << mkTable (htmlShowMultiResults results args get_result result_ok)
   +++ hr

@@ -243,6 +252,8 @@ htmlShowResults
         -> (a -> Bool)
         -> HtmlTable
 
         -> (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)
 htmlShowResults (r:rs) ss f stat result_ok
   =   tabHeader ss
   </> aboves (zipWith tableRow [1..] results_per_prog)

@@ -265,6 +276,8 @@ htmlShowMultiResults
         -> (a -> Bool)
         -> HtmlTable
 
         -> (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)
 htmlShowMultiResults (r:rs) ss f result_ok =
         multiTabHeader ss
          </> aboves (map show_results_for_prog results_per_prog_mod_run)

@@ -275,7 +288,6 @@ htmlShowMultiResults (r:rs) ss f result_ok =
                                             <-> tableRow (-1) ("", highs)])
                            ++ [td << bold << "Average"
                                <-> tableRow (-1) ("", gms)])
                                             <-> tableRow (-1) ("", highs)])
                            ++ [td << bold << "Average"
                                <-> tableRow (-1) ("", gms)])

-

   where
         base_results = Map.toList r :: [(String,Results)]
 
   where
         base_results = Map.toList r :: [(String,Results)]
 

@@ -283,7 +295,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])
         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
 
 
            where fms = map get_run_results rs
 

@@ -291,8 +304,8 @@ htmlShowMultiResults (r:rs) ss f result_ok =
                                         Nothing  -> Map.empty
                                         Just res -> f res
 
                                         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 id_attr

 
         show_results_for_prog (prog,mrs) =
             td <! [valign "top"] << bold << prog
 
         show_results_for_prog (prog,mrs) =
             td <! [valign "top"] << bold << prog

@@ -314,6 +327,7 @@ tableRow row_no (prog, results)
             | even row_no = bgcolor even_row_color
             | otherwise   = bgcolor odd_row_color
 
             | even row_no = bgcolor even_row_color
             | otherwise   = bgcolor odd_row_color
 

+left_column_color, odd_row_color, even_row_color, average_row_color :: String

 left_column_color = "#d0d0ff"  -- light blue
 odd_row_color     = "#d0d0ff"  -- light blue
 even_row_color    = "#f0f0ff"  -- v. light blue
 left_column_color = "#d0d0ff"  -- light blue
 odd_row_color     = "#d0d0ff"  -- light blue
 even_row_color    = "#f0f0ff"  -- v. light blue

@@ -333,38 +347,36 @@ findBest stuff@(Result base : rest)
         unPcnt (_ : rest)                = unPcnt rest
 -}
 
         unPcnt (_ : rest)                = unPcnt rest
 -}
 

+logHeaders :: [String] -> HtmlTable

 logHeaders ss
   = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
 
 logHeaders ss
   = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
 

+mkTable :: HtmlTable -> Html

 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
 
 mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
 

+tabHeader :: [String] -> HtmlTable

 tabHeader ss
   =   (td <! [align "left", width "100"] << bold << "Program")
   <-> logHeaders ss
 
 tabHeader ss
   =   (td <! [align "left", width "100"] << bold << "Program")
   <-> logHeaders ss
 

+multiTabHeader :: [String] -> HtmlTable

 multiTabHeader ss
   =   (td <! [align "left", width "100"] << bold << "Program")
   <-> (td <! [align "left", width "100"] << bold << "Module")
   <-> logHeaders ss
 
 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.
 multiTabHeader ss
   =   (td <! [align "left", width "100"] << bold << "Program")
   <-> (td <! [align "left", width "100"] << bold << "Module")
   <-> logHeaders ss
 
 -- Calculate a color ranging from bright blue for -100% to bright red for +100%.

-

 calcColor :: Int -> String
 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)
 
 
 -----------------------------------------------------------------------------
 -- 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"
    (if (length results == 2)
         then ascii_summary_table True results summary_spec summary_rows
             . str "\n\n"

@@ -374,6 +386,8 @@ latexOutput results args summary_spec summary_rows =
 -----------------------------------------------------------------------------
 -- ASCII page generation
 
 -----------------------------------------------------------------------------
 -- ASCII page generation
 

+asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String]
+          -> String

 asciiPage results args summary_spec summary_rows =
   ( str reportTitle
   . str "\n\n"
 asciiPage results args summary_spec summary_rows =
   ( str reportTitle
   . str "\n\n"

@@ -386,21 +400,24 @@ asciiPage results args summary_spec summary_rows =
   . interleave "\n\n" (map (asciiGenModTable results args)  per_module_result_tab)
   ) "\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)
-  = 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
 
   . 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
 
   . 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)
         = 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
         . str "\n-------------------------------------------------------------------------------\n"
 
 ascii_show_results

@@ -412,6 +429,8 @@ ascii_show_results
         -> (a -> Bool)
         -> ShowS
 
         -> (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)
 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)

@@ -437,13 +456,19 @@ ascii_summary_table
         -> [PerProgTableSpec]
         -> Maybe [String]
         -> ShowS
         -> [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 =
 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
   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"]
 
         (headings, columns, av_cols) = unzip3 (map calc_col specs)
         av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]

@@ -457,15 +482,16 @@ ascii_summary_table latex (r1:r2:_) specs mb_restrict
              | otherwise = rows1
 
         av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
              | otherwise = rows1
 
         av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))

-        width   = 10
+        w   = 10

 
         calc_col (SpecP _ heading _ getr gets ok)
 
         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
                 column = map (\(_:b:_) -> b) boxes
           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
+                (_, column_mean, _) = calc_gmsd column
+                (column_min, column_max) = calc_minmax column

 
 restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
 restrictRows Nothing rows = rows
 
 restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
 restrictRows Nothing rows = rows

@@ -486,10 +512,11 @@ mungeForLaTeX = map transrow
         transchar '_' s = '\\':'_':s
         transchar c s = c:s
 
         transchar '_' s = '\\':'_':s
         transchar c s = c:s
 

-table_layout n width =
+table_layout :: Int -> Int -> Layout
+table_layout n w =

   (str . rjustify 15) :
   (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
 
 ascii_show_multi_results
    :: Result a

@@ -499,6 +526,8 @@ ascii_show_multi_results
         -> (a -> Bool)
         -> ShowS
 
         -> (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)
 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)

@@ -517,7 +546,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])
         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
 
 
            where fms = map get_run_results rs
 

@@ -525,8 +555,8 @@ ascii_show_multi_results (r:rs) ss f result_ok
                                         Nothing  -> Map.empty
                                         Just res -> f res
 
                                         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 id_attr

 
         show_results_for_prog (prog,mrs) =
               str ("\n"++prog++"\n")
 
         show_results_for_prog (prog,mrs) =
               str ("\n"++prog++"\n")

@@ -543,10 +573,11 @@ 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 :: (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)
         = str (rjustify 15 prog)
         . str (space 5)

-        . foldr (.) id (map (str . rjustify width . showBox) results)
+        . foldr (.) id (map (str . rjustify w . showBox) results)

 
 -- ---------------------------------------------------------------------------
 -- Generic stuff for results generation
 
 -- ---------------------------------------------------------------------------
 -- Generic stuff for results generation

@@ -562,7 +593,7 @@ calc_result
         -> (String,[BoxValue])
 
 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =
         -> (String,[BoxValue])
 
 calc_result rts get_maybe_a get_stat result_ok (prog,base_r) =

-        (prog, (just_result baseline base_stat :
+        (prog, (just_result m_baseline base_stat :

 
           let
                 rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
 
           let
                 rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts

@@ -571,22 +602,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
           (
                 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
+                 | result_ok baseline
+                  -> map (\(r,s) -> percentage  r s baseline) rts'
+                _ -> map (\(r,s) -> just_result r s) rts'

            )))
  where
            )))
  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
         base_stat = get_stat base_r
 
         just_result Nothing  s = RunFailed s

-        just_result (Just a) s = toBox a
+        just_result (Just a) _ = toBox a

 
 

-        percentage Nothing   s base = RunFailed s
-        percentage (Just a)  s base = Percentage
-                                         (convert_to_percentage base a)
+        percentage Nothing   s _    = RunFailed s
+        percentage (Just a)  _ baseline
+            = Percentage (convert_to_percentage baseline a)

 -----------------------------------------------------------------------------
 -- Calculating geometric means and standard deviations
 
 -----------------------------------------------------------------------------
 -- Calculating geometric means and standard deviations
 

@@ -622,14 +653,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)
 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,
                        in
                        (Percentage (gm/sdf),
                         Percentage gm,

@@ -658,22 +689,23 @@ class Num a => Result a where
 -- We assume an Int is a size, and print it in kilobytes.
 
 instance Result Int where
 -- 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
+    convert_to_percentage 0 _ = 100
+    convert_to_percentage baseline val
+        = (fromIntegral val / fromIntegral baseline) * 100

 
 

-        toBox = BoxInt
+    toBox = BoxInt

 
 instance Result Integer where
 
 instance Result Integer where

-        convert_to_percentage 0 size = 100
-        convert_to_percentage base size = (fromInteger size / fromInteger base) * 100
-        toBox = BoxInteger
-
+    convert_to_percentage 0 _ = 100
+    convert_to_percentage baseline val
+        = (fromInteger val / fromInteger baseline) * 100
+    toBox = BoxInteger

 
 instance Result Float where
 
 instance Result Float where

-        convert_to_percentage 0.0 size = 100.0
-        convert_to_percentage base size = size / base * 100
+    convert_to_percentage 0.0 _ = 100.0
+    convert_to_percentage baseline val = val / baseline * 100

 
 

-        toBox = BoxFloat
+    toBox = BoxFloat

 
 -- -----------------------------------------------------------------------------
 -- BoxValues
 
 -- -----------------------------------------------------------------------------
 -- BoxValues

@@ -689,20 +721,18 @@ data BoxValue
 
 showBox :: BoxValue -> String
 showBox (RunFailed stat) = show_stat stat
 
 showBox :: BoxValue -> String
 showBox (RunFailed stat) = show_stat stat

-showBox (Percentage f)   = show_pcntage f
+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"
 showBox (BoxString s)    = s
 
 showBox (BoxFloat f)     = printf "%.2f" 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 n
-  | n >= 0    = printf "+%.1f" n
-  | otherwise = printf "%.1f" n
+instance Show BoxValue where
+    show = showBox

 
 

+show_stat :: Status -> String

 show_stat Success     = "(no result)"
 show_stat WrongStdout = "(stdout)"
 show_stat WrongStderr = "(stderr)"
 show_stat Success     = "(no result)"
 show_stat WrongStdout = "(stdout)"
 show_stat WrongStderr = "(stderr)"

@@ -721,8 +751,8 @@ data TableRow
 type Layout = [String -> ShowS]
 
 makeTable :: Layout -> [TableRow] -> ShowS
 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
         do_row TableLine = str (take 80 (repeat '-'))
 
 makeLatexTable :: [TableRow] -> ShowS

@@ -747,15 +777,19 @@ applyLayout layout values =
 -- General Utils
 
 split :: Char -> String -> [String]
 -- 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
 
 str = showString
 

+interleave :: String -> [ShowS] -> ShowS

 interleave s = foldr1 (\a b -> a . str s . b)
 
 interleave s = foldr1 (\a b -> a . str s . b)
 

-fIELD_WIDTH = 16 :: Int
+fIELD_WIDTH :: Int
+fIELD_WIDTH = 16

 
 -----------------------------------------------------------------------------
 
 -----------------------------------------------------------------------------