X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcReport.hs;h=d3e3ef07232aba40553fb36ac67688c5f0a0176f;hb=8e4e15d8e837b90190b6b8e7645822772cab2053;hp=77d66bd9cd8af9a43bee1f9b31985dc5d579c290;hpb=5f4e77a5a2ea03286b795da4051272ac7c774bd7;p=ghc-hetmet.git

diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs
index 77d66bd..d3e3ef0 100644
--- a/utils/hpc/HpcReport.hs
+++ b/utils/hpc/HpcReport.hs
@@ -5,15 +5,13 @@
 
 module HpcReport (report_plugin) where
 
-import System.Exit
 import Prelude hiding (exp)
-import System(getArgs)
-import List(sort,intersperse,sortBy)
+import Data.List(sort,intersperse,sortBy)
 import HpcFlags
 import Trace.Hpc.Mix
 import Trace.Hpc.Tix
 import Control.Monad hiding (guard)
-import qualified HpcSet as Set
+import qualified Data.Set as Set
 
 notExpecting :: String -> a
 notExpecting s = error ("not expecting "++s)
@@ -104,8 +102,8 @@ allBinCounts mi =
 
 accumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo
 accumCounts [] mi = mi
-accumCounts ((bl,btc):etc) mi | single bl =
-  accumCounts etc mi'
+accumCounts ((bl,btc):etc) mi
+ | single bl = accumCounts etc mi'
   where
   mi' = case bl of
         ExpBox False ->   mi{exp = inc (exp mi)}
@@ -120,6 +118,7 @@ accumCounts ((bl,btc):etc) mi | single bl =
        , tixCount = tc + bit (btc>0) }
   upd dp dps =
     if btc>0 then dps else dp:dps
+accumCounts [_] _ = error "accumCounts: Unhandled case: [_] _"
 accumCounts ((bl0,btc0):(bl1,btc1):etc) mi =
   accumCounts etc mi'
   where
@@ -152,14 +151,14 @@ single (BinBox {}) = False
 
 modInfo :: Flags -> Bool -> TixModule -> IO ModInfo
 modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
-  Mix _ _ _ _ mes <- readMixWithFlags hpcflags tix
+  Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix)
   return (q (accumCounts (zip (map snd mes) tickCounts) miZero))
   where
   q mi = if qualDecList then mi{decPaths = map (moduleName:) (decPaths mi)}
          else mi
 
 modReport :: Flags -> TixModule -> IO ()
-modReport hpcflags tix@(TixModule moduleName _ _ tickCounts) = do
+modReport hpcflags tix@(TixModule moduleName _ _ _) = do
   mi <- modInfo hpcflags False tix
   if xmlOutput hpcflags 
     then putStrLn $ "  <module name = " ++ show moduleName  ++ ">"
@@ -201,6 +200,7 @@ modDecList hpcflags mi0 =
   showDecPath dp = putStrLn ("     "++
                              concat (intersperse "." dp))
 
+report_plugin :: Plugin
 report_plugin = Plugin { name = "report"
 	      	       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
 		       , options = report_options 
@@ -222,12 +222,12 @@ report_main hpcflags (progName:mods) = do
     Just (Tix tickCounts) ->
     	   makeReport hpcflags1 progName 
 		    $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)
-	   	    $ [ tix
-	   	      | tix@(TixModule m _h _ tcs) <- tickCounts
+	   	    $ [ tix'
+	   	      | tix'@(TixModule m _ _ _) <- tickCounts
 		      , allowModule hpcflags1 m 
 		      ]
     Nothing -> hpcError report_plugin  $ "unable to find tix file for:" ++ progName
-report_main hpcflags [] = 
+report_main _ [] = 
         hpcError report_plugin $ "no .tix file or executable name specified" 
 
 makeReport :: Flags -> String -> [TixModule] -> IO ()
@@ -256,12 +256,15 @@ element tag attrs = putStrLn $
 			   	   | (x,y) <- attrs
 				   ] ++ "/>"
 
+xmlBT :: BoxTixCounts -> [(String, String)]
 xmlBT (BT b t) = [("boxes",show b),("count",show t)]
 
+xmlBBT :: BinBoxTixCounts -> [(String, String)]
 xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),("count",show (tt + tf + bt))]
 
 ------------------------------------------------------------------------------
 
+report_options :: FlagOptSeq
 report_options 
         = perModuleOpt
         . decListOpt