X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=glafp-utils%2Fnofib-analyse%2FMain.hs;h=12a7655a4172eda302c7e898ad682d3495239fc8;hb=d5254eea37cf82e8f215469e3186cec4069893e1;hp=91cdfd10e7d225a4d276d8395a8388cb5b1408f6;hpb=8d5bf65c745546ce36fad5e09bfd94f38cd62119;p=ghc-hetmet.git diff --git a/glafp-utils/nofib-analyse/Main.hs b/glafp-utils/nofib-analyse/Main.hs index 91cdfd1..12a7655 100644 --- a/glafp-utils/nofib-analyse/Main.hs +++ b/glafp-utils/nofib-analyse/Main.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.4 2000/07/05 15:42:19 keithw Exp $ +-- $Id: Main.hs,v 1.7 2002/08/21 12:58:56 simonmar Exp $ -- (c) Simon Marlow 1997-1999 ----------------------------------------------------------------------------- @@ -9,9 +9,10 @@ module Main where import GenUtils import Printf import Slurp -import DataHtml import CmdLine +import Html hiding ((!)) +import qualified Html ((!)) import GlaExts import FiniteMap import GetOpt @@ -22,6 +23,8 @@ import Array import System import List +( tooquick_threshold ----------------------------------------------------------------------------- -- HTML page generation +--htmlPage :: Results -> [String] -> Html htmlPage results args - = header [] (theTitle [] (htmlStr reportTitle)) - +++ bar [] - +++ h1 [] (htmlStr reportTitle) + = 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]) ] @@ -180,14 +182,14 @@ htmlShowMultiResults htmlShowMultiResults (r:rs) ss f result_ok = multiTabHeader ss - +/+ foldr1 (+/+) (map show_results_for_prog results_per_prog_mod_run) - +/+ foldr1 (+/+) ((if nodevs then [] - else [(cellHtml [] (bold [] (htmlStr "-1 s.d."))) - +-+ tableRow (-1) ("", lows), - (cellHtml [] (bold [] (htmlStr "+1 s.d."))) - +-+ tableRow (-1) ("", highs)]) - ++ [cellHtml [] (bold [] (htmlStr "Average")) - +-+ tableRow (-1) ("", gms)]) + 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)] @@ -208,11 +210,11 @@ htmlShowMultiResults (r:rs) ss f result_ok = result_ok (id,attr) show_results_for_prog (prog,mrs) = - cellHtml [valign "top"] (bold [] (htmlStr prog)) - +-+ (if null mrs then - cellHtml [] (htmlStr "(no modules compiled)") + td (if null mrs then + td << "(no modules compiled)" else - foldr1 (+/+) (map (tableRow 0) mrs)) + toHtml (aboves (map (tableRow 0) mrs))) results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run, (_,xs) <- mods] @@ -220,9 +222,9 @@ htmlShowMultiResults (r:rs) ss f result_ok = tableRow :: Result a => Int -> (String, [BoxValue a]) -> 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%. @@ -395,7 +395,7 @@ class Num a => Result a where instance Result Int where convert_to_percentage 0 size = 100 - convert_to_percentage base size = (fromInt size / fromInt base) * 100 + convert_to_percentage base size = (fromIntegral size / fromIntegral base) * 100 result_to_string n = show (n `div` 1024) ++ "k" @@ -489,7 +489,7 @@ calc_gmsd :: [BoxValue a] -> (BoxValue Float, BoxValue Float, BoxValue Float) calc_gmsd xs | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone) | otherwise = let sqr x = x * x - len = fromInt (length percentages) + len = fromIntegral (length percentages) logs = map log percentages lbar = sum logs / len devs = map (sqr . (lbar-)) logs