When linking a shared library with --make, always do the link step

[ghc-hetmet.git] / utils / hpc / HpcFlags.hs

diff --git a/utils/hpc/HpcFlags.hs b/utils/hpc/HpcFlags.hs
index 68bd861..30cc401 100644 (file)
--- a/utils/hpc/HpcFlags.hs
+++ b/utils/hpc/HpcFlags.hs
@@ -3,7 +3,6 @@
 module HpcFlags where
 
 import System.Console.GetOpt
-import Data.Maybe ( fromMaybe )
 import qualified HpcSet as Set
 import Data.Char
 import Trace.Hpc.Tix
@@ -25,10 +24,12 @@ 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
 default_flags = Flags
   { outputFile         = "-"
   , includeMods         = Set.empty
@@ -45,12 +46,15 @@ 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.
 
+default_final_flags :: Flags -> Flags
 default_final_flags flags = flags 
   { srcDirs = if null (srcDirs flags)
              then ["."]
@@ -68,6 +72,10 @@ anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail
 infoArg :: String -> FlagOptSeq
 infoArg info = (:) $ Option [] [] (NoArg $ id) info
 
+excludeOpt, includeOpt, hpcDirOpt, srcDirOpt, destDirOpt, outputOpt,
+    perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt,
+    altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt,
+    mapFunOptInfo, unionModuleOpt :: FlagOptSeq
 excludeOpt      = anArg "exclude"    "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"  
                 $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
 
@@ -98,28 +106,42 @@ 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 mod = readMix [ dir ++  "/" ++ hpcDir flags
-                                     | dir <- srcDirs flags 
-                                     ] mod
+readMixWithFlags :: Flags -> Either String TixModule -> IO Mix
+readMixWithFlags flags modu = readMix [ dir ++  "/" ++ hpcDir flags
+                                      | dir <- srcDirs flags 
+                                      ] modu
 
 -------------------------------------------------------------------------------
 
+command_usage :: Plugin -> IO ()
 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 [])
@@ -177,9 +199,44 @@ 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  _ = 0
+thePostFun ZERO _ = 0
+
+postFuns :: [(String, PostFun)]
+postFuns = [ (show pos,pos) 
+            | pos <- [ID .. 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 :: [(String, MergeFun)]
+mergeFuns = [ (show pos,pos) 
+            | pos <- [INTERSECTION,UNION]
+          ]
+