Make "runghc -f path-to-ghc Main.hs" work
[ghc-hetmet.git] / utils / nofib-analyse / Main.hs
index cd9230a..9e8088b 100644 (file)
@@ -11,19 +11,19 @@ import Slurp
 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
 import Data.List
 
+(<!) :: Text.Html.ADDATTRS a => a -> [HtmlAttr] -> a
 (<!) = (Html.!)
 
 -----------------------------------------------------------------------------
@@ -32,26 +32,19 @@ import Data.List
 die :: String -> IO a
 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
 
-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 ++ usage)
 
- 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
 
@@ -66,15 +59,15 @@ main = do
  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)
 
 
@@ -92,7 +85,7 @@ parse_logs log_files =
 
 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
@@ -102,13 +95,16 @@ data PerProgTableSpec =
 
 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
@@ -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
 
+all_specs :: [PerProgTableSpec]
 all_specs = [
   size_spec,
   alloc_spec,
@@ -135,7 +132,7 @@ all_specs = [
 
 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)
@@ -155,7 +152,7 @@ checkTimes prog results = do
   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)
@@ -166,26 +163,30 @@ 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 ]
 
 -- 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
@@ -200,7 +201,7 @@ time_ok t = t > tooquick_threshold
 -----------------------------------------------------------------------------
 -- HTML page generation
 
---htmlPage :: Results -> [String] -> Html
+htmlPage :: [ResultTable] -> [String] -> Html
 htmlPage results args
    =  header << thetitle << reportTitle
           +++ hr
@@ -209,32 +210,40 @@ 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 <! [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 =
-  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
 
-htmlGenModTable results args (SpecM title anc get_result result_ok)
-  =   sectHeading title anc 
-  +++ font <![size "1"] 
+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
 
 sectHeading :: String -> String -> Html
 sectHeading s nm = h2 << anchor <! [name nm] << s
 
-htmlShowResults 
+htmlShowResults
     :: Result a
         => [ResultTable]
         -> [String]
@@ -243,6 +252,8 @@ htmlShowResults
         -> (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)
@@ -253,7 +264,7 @@ htmlShowResults (r:rs) ss f stat 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)
 
@@ -265,8 +276,10 @@ htmlShowMultiResults
         -> (a -> Bool)
         -> HtmlTable
 
+htmlShowMultiResults []     _  _ _
+ = error "htmlShowMultiResults: Can't happen?"
 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."
@@ -275,7 +288,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 +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])
-        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 +304,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 id_attr
 
         show_results_for_prog (prog,mrs) =
             td <! [valign "top"] << bold << prog
@@ -308,12 +321,13 @@ htmlShowMultiResults (r:rs) ss f result_ok =
 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
             | 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
@@ -333,38 +347,36 @@ findBest stuff@(Result base : rest)
         unPcnt (_ : rest)                = unPcnt rest
 -}
 
+logHeaders :: [String] -> HtmlTable
 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
 
+tabHeader :: [String] -> HtmlTable
 tabHeader ss
-  =   (td <! [align "left", width "100"] << bold << "Program") 
+  =   (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%.
-
 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"
@@ -374,6 +386,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"
@@ -386,21 +400,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
@@ -412,6 +429,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)
@@ -425,25 +444,31 @@ ascii_show_results (r:rs) ss f stat 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]
         -> 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)
+  | otherwise =
+       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"]
@@ -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))
-        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
                 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
@@ -486,10 +512,11 @@ mungeForLaTeX = map transrow
         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)
+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)
 
 ascii_show_multi_results
    :: Result a
@@ -499,8 +526,10 @@ 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 
+        = ascii_header fIELD_WIDTH ss
         . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
         . str "\n"
         . if nodevs then id
@@ -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])
-        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
 
@@ -525,8 +555,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 id_attr
 
         show_results_for_prog (prog,mrs) =
               str ("\n"++prog++"\n")
@@ -543,16 +573,17 @@ 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)
 
 -- ---------------------------------------------------------------------------
 -- 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
@@ -562,7 +593,7 @@ calc_result
         -> (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
@@ -571,28 +602,28 @@ 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
+                 | result_ok baseline
+                  -> map (\(r,s) -> percentage  r s baseline) rts'
+                _ -> 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) 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
 
 {-
 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
 
@@ -620,16 +651,16 @@ We therefore return a (low, mean, high) triple.
 -}
 
 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)
-                           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,
@@ -642,7 +673,7 @@ calc_gmsd xs
 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 ]
@@ -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
-        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
-        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
-        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
@@ -689,20 +721,18 @@ data BoxValue
 
 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
 
-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)"
@@ -721,8 +751,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
@@ -740,22 +770,26 @@ latexTableLayout = box : repeat (box . (" & "++))
         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 ]
 
 -- -----------------------------------------------------------------------------
 -- 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 s = foldr1 (\a b -> a . str s . b) 
+interleave :: String -> [ShowS] -> ShowS
+interleave s = foldr1 (\a b -> a . str s . b)
 
-fIELD_WIDTH = 16 :: Int
+fIELD_WIDTH :: Int
+fIELD_WIDTH = 16
 
 -----------------------------------------------------------------------------