Improving the combine mode for hpc

we now have
Processing Coverage files:
  sum         Sum multiple .tix files in a single .tix file
  combine     Combine two .tix files in a single .tix file
  map         Map a function over a single .tix file

Where sum joins many .tix files, combine joins two files (with
extra functionality possible), and map just applied a function
to single .tix file.

These changes were improvements driven by hpc use cases.

END OF DESCRIPTION***

Place the long patch description above the ***END OF DESCRIPTION*** marker.
The first line of this file will be the patch name.


This patch contains the following changes:

M ./utils/hpc/Hpc.hs -1 +3
M ./utils/hpc/HpcCombine.hs -33 +84
M ./utils/hpc/HpcFlags.hs -11 +59

1 files changed, 59 insertions, 11 deletions

diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs
index 30d46799f1..761163f2dc 100644
--- a/utils/hpc/HpcFlags.hs
+++ b/utils/hpc/HpcFlags.hs
@@ -25,8 +25,9 @@ data Flags = Flags
   , funTotals           :: Bool
   , altHighlight        :: Bool
 
-  , combineFun          :: CombineFun
-  , postInvert		:: Bool
+  , combineFun          :: CombineFun	-- tick-wise combine
+  , postFun		:: PostFun	-- 
+  , mergeModule		:: MergeFun	-- module-wise merge
   }
 
 default_flags = Flags
@@ -45,9 +46,11 @@ default_flags = Flags
   , altHighlight        = False
 
   , combineFun          = ADD
-  , postInvert		= False
+  , postFun             = ID
+  , mergeModule		= INTERSECTION
   }
 
+
 -- We do this after reading flags, because the defaults
 -- depends on if specific flags we used.
 
@@ -98,16 +101,27 @@ altHighlightOpt
 	      = noArg "highlight-covered" "highlight covered code, rather that code gaps"
 							      $ \ f -> f { altHighlight = True }  
 
-combineFunOpt = anArg "combine" 
+combineFunOpt = anArg "function" 
 	      	      "combine .tix files with join function, default = ADD" "FUNCTION"
 	      $ \ a f -> case reads (map toUpper a) of
 	      	          [(c,"")] -> f { combineFun = c }
 			  _ -> error $ "no such combine function : " ++ a
 combineFunOptInfo = infoArg 
-		  $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst combineFuns)
+		  $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst foldFuns)
+
+mapFunOpt = anArg "function"
+	      	      "apply function to .tix files, default = ID" "FUNCTION"
+	      $ \ a f -> case reads (map toUpper a) of
+	      	          [(c,"")] -> f { postFun = c }
+			  _ -> error $ "no such combine function : " ++ a
+mapFunOptInfo = infoArg 
+		  $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst postFuns)
+
+unionModuleOpt = noArg "union"
+	      	      "use the union of the module namespace (default is intersection)"
+	      $ \ f -> f { mergeModule = UNION }
+
 
-postInvertOpt = noArg "post-invert" "invert output; ticked becomes unticked, unticked becomes ticked"
-							      $ \ f -> f { funTotals = True }  
 -------------------------------------------------------------------------------
 
 readMixWithFlags :: Flags -> Either String TixModule -> IO Mix
@@ -121,6 +135,7 @@ command_usage plugin =
   putStrLn $
 				       "Usage: hpc " ++ (name plugin) ++ " " ++ 
 				        (usage plugin) ++
+				        "\n" ++ summary plugin ++ "\n" ++
 				        if null (options plugin [])
 				        then ""
   	                                else usageInfo "\n\nOptions:\n" (options plugin [])
@@ -178,9 +193,42 @@ filterTix flags (Tix tixs) =
 ------------------------------------------------------------------------------
 -- HpcCombine specifics 
 
-data CombineFun = ADD | DIFF | SUB | ZERO
+data CombineFun = ADD | DIFF | SUB 
+     deriving (Eq,Show, Read, Enum)
+
+theCombineFun :: CombineFun -> Integer -> Integer -> Integer
+theCombineFun fn = case fn of
+      	    ADD  -> \ l r -> l + r
+            SUB  -> \ l r -> max 0 (l - r)
+	    DIFF -> \ g b -> if g > 0 then 0 else min 1 b
+
+foldFuns :: [ (String,CombineFun) ]
+foldFuns = [ (show comb,comb) 
+	   | comb <- [ADD .. SUB]
+	   ]
+
+data PostFun = ID | INV | ZERO
      deriving (Eq,Show, Read, Enum)
 
-combineFuns = [ (show comb,comb) 
-	      | comb <- [ADD .. ZERO]
-	      ]
+thePostFun :: PostFun -> Integer -> Integer
+thePostFun ID   x = x
+thePostFun INV  0 = 1
+thePostFun INV  n = 0
+thePostFun ZERO x = 0
+
+postFuns = [ (show pos,pos) 
+	     | pos <- [INV .. ZERO]
+	   ]
+
+
+data MergeFun = INTERSECTION | UNION
+     deriving (Eq,Show, Read, Enum)
+
+theMergeFun :: (Ord a) => MergeFun -> Set.Set a -> Set.Set a -> Set.Set a
+theMergeFun INTERSECTION = Set.intersection
+theMergeFun UNION        = Set.union
+
+mergeFuns = [ (show pos,pos) 
+	     | pos <- [INTERSECTION,UNION]
+	   ]
+