diff options
author | Ian Lynagh <igloo@earth.li> | 2006-12-12 16:46:51 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2006-12-12 16:46:51 +0000 |
commit | ab411f6aad175d29a8cb3752f49f1188ab505e65 (patch) | |
tree | afa965fb94025aedb6df5bc238ee245dc09c3934 /utils | |
parent | aacb44f0de5a337171b1446cab3eaa73f978d480 (diff) | |
download | haskell-ab411f6aad175d29a8cb3752f49f1188ab505e65.tar.gz |
More warning fixes
Diffstat (limited to 'utils')
-rw-r--r-- | utils/nofib-analyse/Main.hs | 73 |
1 files changed, 43 insertions, 30 deletions
diff --git a/utils/nofib-analyse/Main.hs b/utils/nofib-analyse/Main.hs index c0c2903a17..4c8ca7e9c6 100644 --- a/utils/nofib-analyse/Main.hs +++ b/utils/nofib-analyse/Main.hs @@ -23,6 +23,7 @@ import Data.Char import System.IO import Data.List +(<!) :: Text.Html.ADDATTRS a => a -> [HtmlAttr] -> a (<!) = (Html.!) ----------------------------------------------------------------------------- @@ -209,22 +210,30 @@ 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 :: [ResultTable] -> [String] -> PerProgTableSpec -> Html htmlGenProgTable results args (SpecP title _ anc get_result get_status result_ok) = sectHeading title anc +++ font <! [size "1"] << mkTable (htmlShowResults results args get_result get_status result_ok) +++ hr +htmlGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> Html htmlGenModTable results args (SpecM title anc get_result result_ok) = sectHeading title anc +++ font <![size "1"] @@ -283,7 +292,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 +301,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 @@ -352,12 +362,10 @@ multiTabHeader ss <-> 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 +calcColor percentage | percentage >= 0 = "#" ++ (showHex val 2 "0000") + | otherwise = "#0000" ++ (showHex val 2 "") + where val = abs percentage * 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) @@ -464,12 +472,13 @@ ascii_summary_table latex (r1:r2:_) specs mb_restrict width = 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 @@ -521,7 +530,8 @@ ascii_show_multi_results (r:rs) ss f result_ok results_per_prog_mod_run = map get_results_for_prog base_results -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a]) - get_results_for_prog (prog,r) = (prog, map get_results_for_mod (Map.toList (f r))) + get_results_for_prog (prog, results) + = (prog, map get_results_for_mod (Map.toList (f results))) where fms = map get_run_results rs @@ -529,8 +539,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") @@ -626,14 +636,14 @@ We therefore return a (low, mean, high) triple. calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue) calc_gmsd xs | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone) - | otherwise = let sqr x = x * x - len = fromIntegral (length percentages) - logs = map log percentages - lbar = sum logs / len - devs = map (sqr . (lbar-)) logs - dbar = sum devs / len - gm = exp lbar - sdf = exp (sqrt dbar) + | otherwise = let sqr x = x * x + len = fromIntegral (length percentages) + logs = map log percentages + lbar = sum logs / len + st_devs = map (sqr . (lbar-)) logs + dbar = sum st_devs / len + gm = exp lbar + sdf = exp (sqrt dbar) in (Percentage (gm/sdf), Percentage gm, @@ -722,8 +732,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 @@ -753,10 +763,13 @@ split c s = case rest of _:rest -> chunk : split c rest where (chunk, rest) = break (==c) s +str :: String -> ShowS str = showString +interleave :: String -> [ShowS] -> ShowS interleave s = foldr1 (\a b -> a . str s . b) -fIELD_WIDTH = 16 :: Int +fIELD_WIDTH :: Int +fIELD_WIDTH = 16 ----------------------------------------------------------------------------- |