projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2004-02-12 02:04:59 by mthomas]
[ghc-hetmet.git] / glafp-utils / nofib-analyse / Main.hs
diff --git a/glafp-utils/nofib-analyse/Main.hs b/glafp-utils/nofib-analyse/Main.hs
index 299b6f8..c073eab 100644 (file)
--- a/glafp-utils/nofib-analyse/Main.hs
+++ b/glafp-utils/nofib-analyse/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.3 2000/03/02 11:39:45 keithw Exp $
+-- $Id: Main.hs,v 1.8 2002/09/18 12:36:39 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
 
+(<!) = (Html.!)
+
 -----------------------------------------------------------------------------
 -- Top level stuff
 
@@ -96,6 +99,7 @@ per_prog_result_tab =
        , SpecP "Instructions" "instrs" instrs run_status always_ok
        , SpecP "Memory Reads" "mem-reads" mem_reads run_status always_ok
        , SpecP "Memory Writes" "mem-writes" mem_writes run_status always_ok
+       , SpecP "Cache Misses" "cache-misses" cache_misses run_status always_ok
        ]
 
 per_module_result_tab =
@@ -112,39 +116,39 @@ time_ok t = t > tooquick_threshold
 -----------------------------------------------------------------------------
 -- HTML page generation
 
+--htmlPage :: Results -> [String] -> Html
 htmlPage results args
-   =  header [] (theTitle [] (htmlStr "NoFib Results"))
-         +++ bar []
+   =  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 <! [href ('#':anc)] << name
+module_menu_item (SpecM name anc _ _) = anchor <! [href ('#':anc)] << name
 
 gen_tables results args =
   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 
-  +++ font [size 1] (
-         mkTable (htmlShowResults results args get_result get_status result_ok))
-  +++ bar []
+  =   sectHeading title 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] (
-         mkTable (htmlShowMultiResults results args get_result result_ok))
-  +++ bar []
+  +++ font <![size "1"] 
+        << mkTable (htmlShowMultiResults results args get_result result_ok)
+  +++ hr
 
 sectHeading :: String -> String -> Html
-sectHeading s nm
-       = h2 [] (anchor [name nm] (htmlStr s))
+sectHeading s nm = h2 << anchor <! [name nm] << s
 
 htmlShowResults 
     :: Result a
@@ -157,10 +161,10 @@ htmlShowResults
 
 htmlShowResults (r:rs) ss f stat result_ok
   =   tabHeader ss
-  +/+ foldr1 (+/+) (zipWith tableRow [1..] results_per_prog)
-  +/+ foldr1 (+/+) ((if nodevs then []
-                               else [tableRow (-1) ("-1 s.d.", lows),
-                                     tableRow (-1) ("+1 s.d.", highs)])
+  </> 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]) ]
@@ -179,14 +183,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)]
@@ -207,11 +211,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 <! [valign "top"] << bold << prog
+           <-> (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]
@@ -219,9 +223,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 <! [bgcolor left_column_color] << prog
+       <-> besides (map (\s -> td <! [align "right", clr] << show_box s) 
+                               results)
   where clr | row_no < 0  = bgcolor average_row_color
            | even row_no = bgcolor even_row_color
            | otherwise   = bgcolor odd_row_color
@@ -246,20 +250,18 @@ findBest stuff@(Result base : rest)
 -}
 
 logHeaders ss
-  = foldr1 (+-+) (map (\s -> cellHtml [align "right", width "100"] 
-       (bold [] (htmlStr s))) ss)
+  = besides (map (\s -> (td <! [align "right", width "100"] << bold << s)) ss)
 
-mkTable :: HtmlTable -> Html
-mkTable = renderTable [cellspacing 0, cellpadding 0, border 0]
+mkTable t = table <! [cellspacing 0, cellpadding 0, border 0] << t
 
 tabHeader ss
-  =   cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
-  +-+ logHeaders ss
+  =   (td <! [align "left", width "100"] << bold << "Program") 
+  <-> logHeaders ss
 
 multiTabHeader ss
-  =   cellHtml [align "left", width "100"] (bold [] (htmlStr "Program"))
-  +-+ cellHtml [align "left", width "100"] (bold [] (htmlStr "Module"))
-  +-+ logHeaders 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%.
 
@@ -279,7 +281,9 @@ hexDig i | i > 10 = chr (i-10 + ord 'a')
 -- ASCII page generation
 
 asciiPage results args =
-  ( interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
+  ( str reportTitle
+  . str "\n\n"
+  . interleave "\n\n" (map (asciiGenProgTable results args) per_prog_result_tab)
   . str "\n"
   . interleave "\n\n" (map (asciiGenModTable results args)  per_module_result_tab)
   ) "\n"
@@ -392,7 +396,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"
 
@@ -486,7 +490,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
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)