Commit 1267b64b authored by andy@galois.com's avatar andy@galois.com
Browse files

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
parent d3e977c6
......@@ -28,7 +28,7 @@ helpList =
help = ["help"]
reporting = ["report","markup"]
overlays = ["overlay","draft"]
processing = ["combine"]
processing = ["sum","combine","map"]
other = [ name hook
| hook <- hooks
, name hook `notElem`
......@@ -77,7 +77,9 @@ main = do
hooks = [ help_plugin
, report_plugin
, markup_plugin
, sum_plugin
, combine_plugin
, map_plugin
, showtix_plugin
, overlay_plugin
, draft_plugin
......
......@@ -3,7 +3,7 @@
-- Andy Gill, Oct 2006
---------------------------------------------------------
module HpcCombine (combine_plugin) where
module HpcCombine (sum_plugin,combine_plugin,map_plugin) where
import Trace.Hpc.Tix
import Trace.Hpc.Util
......@@ -16,64 +16,115 @@ import qualified HpcMap as Map
import System.Environment
------------------------------------------------------------------------------
sum_options
= excludeOpt
. includeOpt
. outputOpt
. unionModuleOpt
sum_plugin = Plugin { name = "sum"
, usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]"
, options = sum_options
, summary = "Sum multiple .tix files in a single .tix file"
, implementation = sum_main
, init_flags = default_flags
, final_flags = default_final_flags
}
combine_options
= excludeOpt
. includeOpt
. outputOpt
. combineFunOpt
. combineFunOptInfo
. postInvertOpt
. unionModuleOpt
combine_plugin = Plugin { name = "combine"
, usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]"
, usage = "[OPTION] .. <TIX_FILE> <TIX_FILE>"
, options = combine_options
, summary = "Combine multiple .tix files in a single .tix files"
, summary = "Combine two .tix files in a single .tix file"
, implementation = combine_main
, init_flags = default_flags
, final_flags = default_final_flags
}
------------------------------------------------------------------------------
map_options
= excludeOpt
. includeOpt
. outputOpt
. mapFunOpt
. mapFunOptInfo
. unionModuleOpt
combine_main :: Flags -> [String] -> IO ()
combine_main flags (first_file:more_files) = do
-- combine does not expand out the .tix filenames (by design).
map_plugin = Plugin { name = "map"
, usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]"
, options = map_options
, summary = "Map a function over a single .tix file"
, implementation = map_main
, init_flags = default_flags
, final_flags = default_final_flags
}
let f = case combineFun flags 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
ZERO -> \ _ _ -> 0
------------------------------------------------------------------------------
sum_main :: Flags -> [String] -> IO ()
sum_main flags [] = hpcError sum_plugin $ "no .tix file specified"
sum_main flags (first_file:more_files) = do
Just tix <- readTix first_file
tix' <- foldM (mergeTixFile flags f)
tix' <- foldM (mergeTixFile flags (+))
(filterTix flags tix)
more_files
let (Tix inside_tix') = tix'
let inv 0 = 1
inv n = 0
let tix'' = if postInvert flags
then Tix [ TixModule m p i (map inv t)
| TixModule m p i t <- inside_tix'
]
else tix'
case outputFile flags of
"-" -> putStrLn (show tix')
out -> writeTix out tix'
combine_main :: Flags -> [String] -> IO ()
combine_main flags [first_file,second_file] = do
let f = theCombineFun (combineFun flags)
Just tix1 <- readTix first_file
Just tix2 <- readTix second_file
let tix = mergeTix (mergeModule flags)
f
(filterTix flags tix1)
(filterTix flags tix2)
case outputFile flags of
"-" -> putStrLn (show tix)
out -> writeTix out tix
combine_main flags [] = hpcError sum_plugin $ "need exactly two .tix files to combine"
map_main :: Flags -> [String] -> IO ()
map_main flags [first_file] = do
let f = thePostFun (postFun flags)
Just tix <- readTix first_file
let (Tix inside_tix) = filterTix flags tix
let tix' = Tix [ TixModule m p i (map f t)
| TixModule m p i t <- inside_tix
]
case outputFile flags of
"-" -> putStrLn (show tix'')
out -> writeTix out tix''
"-" -> putStrLn (show tix')
out -> writeTix out tix'
map_main flags [] = hpcError sum_plugin $ "no .tix file specified"
map_main flags _ = hpcError sum_plugin $ "to many .tix files specified"
mergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix
mergeTixFile flags fn tix file_name = do
Just new_tix <- readTix file_name
return $! strict $ mergeTix fn tix (filterTix flags new_tix)
return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix)
-- could allow different numbering on the module info,
-- as long as the total is the same; will require normalization.
mergeTix :: (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix
mergeTix f
mergeTix :: MergeFun
-> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix
mergeTix modComb f
(Tix t1)
(Tix t2) = Tix
[ case (Map.lookup m fm1,Map.lookup m fm2) of
......@@ -86,12 +137,12 @@ mergeTix f
-> error $ "mismatched in module " ++ m
| otherwise ->
TixModule m hash1 len1 (zipWith f tix1 tix2)
(Just (TixModule _ hash1 len1 tix1),Nothing) ->
error $ "rogue module " ++ show m
(Nothing,Just (TixModule _ hash2 len2 tix2)) ->
error $ "rogue module " ++ show m
(Just m1,Nothing) ->
m1
(Nothing,Just m2) ->
m2
_ -> error "impossible"
| m <- Set.toList (m1s `Set.intersection` m2s)
| m <- Set.toList (theMergeFun modComb m1s m2s)
]
where
m1s = Set.fromList $ map tixModuleName t1
......
......@@ -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]
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment