[Git][ghc/ghc][master] 4 commits: Remove utils/hpc subdirectory and its contents

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Mar 8 06:24:51 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
f3ff7cb1 by David Binder at 2023-03-08T01:24:17-05:00
Remove utils/hpc subdirectory and its contents

- - - - -
cf98e286 by David Binder at 2023-03-08T01:24:17-05:00
Add git submodule for utils/hpc

- - - - -
605fbbb2 by David Binder at 2023-03-08T01:24:18-05:00
Update commit for utils/hpc git submodule

- - - - -
606793d4 by David Binder at 2023-03-08T01:24:18-05:00
Update commit for utils/hpc git submodule

- - - - -


16 changed files:

- .gitmodules
- + utils/hpc
- − utils/hpc/HpcCombine.hs
- − utils/hpc/HpcDraft.hs
- − utils/hpc/HpcFlags.hs
- − utils/hpc/HpcLexer.hs
- − utils/hpc/HpcMarkup.hs
- − utils/hpc/HpcOverlay.hs
- − utils/hpc/HpcParser.y
- − utils/hpc/HpcReport.hs
- − utils/hpc/HpcShowTix.hs
- − utils/hpc/HpcUtils.hs
- − utils/hpc/Main.hs
- − utils/hpc/Makefile
- − utils/hpc/hpc-bin.cabal
- − utils/hpc/hpc.wrapper


Changes:

=====================================
.gitmodules
=====================================
@@ -110,3 +110,6 @@
 [submodule "libraries/exceptions"]
 	path = libraries/exceptions
 	url = https://gitlab.haskell.org/ghc/packages/exceptions.git
+[submodule "utils/hpc"]
+	path = utils/hpc
+	url = https://gitlab.haskell.org/hpc/hpc-bin.git


=====================================
utils/hpc
=====================================
@@ -0,0 +1 @@
+Subproject commit b376045cb3f3d28815ca29d9c07df2e843cec1c3


=====================================
utils/hpc/HpcCombine.hs deleted
=====================================
@@ -1,197 +0,0 @@
----------------------------------------------------------
--- The main program for the hpc-add tool, part of HPC.
--- Andy Gill, Oct 2006
----------------------------------------------------------
-
-module HpcCombine (sum_plugin,combine_plugin,map_plugin) where
-
-import Trace.Hpc.Tix
-import Trace.Hpc.Util
-
-import HpcFlags
-
-import Control.Monad
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-
-------------------------------------------------------------------------------
-sum_options :: FlagOptSeq
-sum_options
-        = excludeOpt
-        . includeOpt
-        . outputOpt
-        . unionModuleOpt
-        . verbosityOpt
-
-sum_plugin :: Plugin
-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 :: FlagOptSeq
-combine_options
-        = excludeOpt
-        . includeOpt
-        . outputOpt
-        . combineFunOpt
-        . combineFunOptInfo
-        . unionModuleOpt
-        . verbosityOpt
-
-combine_plugin :: Plugin
-combine_plugin = Plugin { name = "combine"
-                        , usage = "[OPTION] .. <TIX_FILE> <TIX_FILE>"
-                        , options = combine_options
-                        , summary = "Combine two .tix files in a single .tix file"
-                        , implementation = combine_main
-                        , init_flags = default_flags
-                        , final_flags = default_final_flags
-                        }
-
-map_options :: FlagOptSeq
-map_options
-        = excludeOpt
-        . includeOpt
-        . outputOpt
-        . mapFunOpt
-        . mapFunOptInfo
-        . unionModuleOpt
-        . verbosityOpt
-
-map_plugin :: Plugin
-map_plugin = Plugin { name = "map"
-                    , usage = "[OPTION] .. <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
-                    }
-
-------------------------------------------------------------------------------
-
-sum_main :: Flags -> [String] -> IO ()
-sum_main _     [] = hpcError sum_plugin $ "no .tix file specified"
-sum_main flags (first_file:more_files) = do
-  Just tix <- readTix first_file
-
-  tix' <- foldM (mergeTixFile flags (+))
-                (filterTix flags tix)
-                more_files
-
-  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 _     _ = hpcError combine_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'
-map_main _     [] = hpcError map_plugin $ "no .tix file specified"
-map_main _     _  = hpcError map_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 (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 :: 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
-           -- todo, revisit the semantics of this combination
-            (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2))
-               | hash1 /= hash2
-               || length tix1 /= length tix2
-               || len1 /= length tix1
-               || len2 /= length tix2
-                     -> error $ "mismatched in module " ++ m
-               | otherwise      ->
-                     TixModule m hash1 len1 (zipWith f tix1 tix2)
-            (Just m1,Nothing) ->
-                  m1
-            (Nothing,Just m2) ->
-                  m2
-            _ -> error "impossible"
-         | m <- Set.toList (theMergeFun modComb m1s m2s)
-         ]
-  where
-   m1s = Set.fromList $ map tixModuleName t1
-   m2s = Set.fromList $ map tixModuleName t2
-
-   fm1 = Map.fromList [ (tixModuleName tix,tix)
-                      | tix <- t1
-                      ]
-   fm2 = Map.fromList [ (tixModuleName tix,tix)
-                      | tix <- t2
-                      ]
-
-
--- What I would give for a hyperstrict :-)
--- This makes things about 100 times faster.
-class Strict a where
-   strict :: a -> a
-
-instance Strict Integer where
-   strict i = i
-
-instance Strict Int where
-   strict i = i
-
-instance Strict Hash where      -- should be fine, because Hash is a newtype round an Int
-   strict i = i
-
-instance Strict Char where
-   strict i = i
-
-instance Strict a => Strict [a] where
-   strict (a:as) = (((:) $! strict a) $! strict as)
-   strict []     = []
-
-instance (Strict a, Strict b) => Strict (a,b) where
-   strict (a,b) = (((,) $! strict a) $! strict b)
-
-instance Strict Tix where
-  strict (Tix t1) =
-            Tix $! strict t1
-
-instance Strict TixModule where
-  strict (TixModule m1 p1 i1 t1) =
-            ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1)


=====================================
utils/hpc/HpcDraft.hs deleted
=====================================
@@ -1,144 +0,0 @@
-module HpcDraft (draft_plugin) where
-
-import Trace.Hpc.Tix
-import Trace.Hpc.Mix
-import Trace.Hpc.Util
-
-import HpcFlags
-
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-import HpcUtils
-import Data.Tree
-
-------------------------------------------------------------------------------
-draft_options :: FlagOptSeq
-draft_options
-        = excludeOpt
-        . includeOpt
-        . srcDirOpt
-        . hpcDirOpt
-        . resetHpcDirsOpt
-        . outputOpt
-        . verbosityOpt
-
-draft_plugin :: Plugin
-draft_plugin = Plugin { name = "draft"
-                       , usage = "[OPTION] .. <TIX_FILE>"
-                       , options = draft_options
-                       , summary = "Generate draft overlay that provides 100% coverage"
-                       , implementation = draft_main
-                       , init_flags = default_flags
-                       , final_flags = default_final_flags
-                       }
-
-------------------------------------------------------------------------------
-
-draft_main :: Flags -> [String] -> IO ()
-draft_main _        []              = error "draft_main: unhandled case: []"
-draft_main hpcflags (progName:mods) = do
-  let hpcflags1 = hpcflags
-                { includeMods = Set.fromList mods
-                                   `Set.union`
-                                includeMods hpcflags }
-  let prog = getTixFileName $ progName
-  tix <- readTix prog
-  case tix of
-    Just (Tix tickCounts) -> do
-        outs <- sequence
-                      [ makeDraft hpcflags1 tixModule
-                      | tixModule@(TixModule m _ _ _) <- tickCounts
-                      , allowModule hpcflags1 m
-                      ]
-        case outputFile hpcflags1 of
-         "-" -> putStrLn (unlines outs)
-         out -> writeFile out (unlines outs)
-    Nothing -> hpcError draft_plugin $ "unable to find tix file for:" ++ progName
-
-
-makeDraft :: Flags -> TixModule -> IO String
-makeDraft hpcflags tix = do
-  let modu = tixModuleName tix
-      tixs = tixModuleTixs tix
-
-  (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix)
-
-  let forest = createMixEntryDom
-              [ (srcspan,(box,v > 0))
-              | ((srcspan,box),v) <- zip entries tixs
-              ]
-
---  let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span)
---  putStrLn $ drawForest $ map (fmap show) $ forest
-
-  let non_ticked = findNotTickedFromList forest
-
-  hs  <- readFileFromPath (hpcError draft_plugin) filepath (srcDirs hpcflags)
-
-  let hsMap :: Map.Map Int String
-      hsMap = Map.fromList (zip [1..] $ lines hs)
-
-  let quoteString = show
-
-  let firstLine pos = case fromHpcPos pos of
-                        (ln,_,_,_) -> ln
-
-
-  let showPleaseTick :: Int -> PleaseTick -> String
-      showPleaseTick d (TickFun str pos) =
-                     spaces d ++ "tick function \"" ++ last str ++ "\" "
-                              ++ "on line " ++ show (firstLine pos) ++ ";"
-      showPleaseTick d (TickExp pos) =
-                     spaces d ++ "tick "
-                              ++ if '\n' `elem` txt
-                                 then "at position " ++ show pos ++ ";"
-                                 else quoteString txt ++ " "  ++ "on line " ++ show (firstLine pos) ++ ";"
-
-          where
-                  txt = grabHpcPos hsMap pos
-
-      showPleaseTick d (TickInside [str] _ pleases) =
-                     spaces d ++ "inside \"" ++ str ++ "\" {\n" ++
-                     showPleaseTicks (d + 2) pleases ++
-                     spaces d ++ "}"
-
-      showPleaseTick _ (TickInside _ _ _)
-          = error "showPleaseTick: Unhandled case TickInside"
-
-      showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases)
-
-      spaces d = take d (repeat ' ')
-
-  return $ "module " ++ show (fixPackageSuffix modu) ++ " {\n" ++
-         showPleaseTicks 2 non_ticked ++ "}"
-
-fixPackageSuffix :: String -> String
-fixPackageSuffix modu = case span (/= '/') modu of
-                        (before,'/':after) -> before ++ ":" ++ after
-                        _                  -> modu
-
-data PleaseTick
-   = TickFun [String] HpcPos
-   | TickExp HpcPos
-   | TickInside [String] HpcPos [PleaseTick]
-    deriving Show
-
-mkTickInside :: [String] -> HpcPos -> [PleaseTick]
-             -> [PleaseTick] -> [PleaseTick]
-mkTickInside _ _ []        = id
-mkTickInside nm pos inside = (TickInside nm pos inside :)
-
-findNotTickedFromTree :: MixEntryDom [(BoxLabel,Bool)] -> [PleaseTick]
-findNotTickedFromTree (Node (pos,(ExpBox {},False):_) _) = [TickExp pos]
-findNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _)
-  = [ TickFun nm pos ]
-findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _)
-  = [ TickFun nm pos ]
-findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children)
-  = mkTickInside nm pos (findNotTickedFromList children) []
-findNotTickedFromTree (Node (pos,_:others) children) =
-                      findNotTickedFromTree (Node (pos,others) children)
-findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children
-
-findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick]
-findNotTickedFromList = concatMap findNotTickedFromTree


=====================================
utils/hpc/HpcFlags.hs deleted
=====================================
@@ -1,268 +0,0 @@
--- (c) 2007 Andy Gill
-
-module HpcFlags where
-
-import System.Console.GetOpt
-import qualified Data.Set as Set
-import Data.Char
-import Trace.Hpc.Tix
-import Trace.Hpc.Mix
-import System.Exit
-import System.FilePath
-
-data Flags = Flags
-  { outputFile          :: String
-  , includeMods         :: Set.Set String
-  , excludeMods         :: Set.Set String
-  , hpcDirs             :: [String]
-  , srcDirs             :: [String]
-  , destDir             :: String
-
-  , perModule           :: Bool
-  , decList             :: Bool
-  , xmlOutput           :: Bool
-
-  , funTotals           :: Bool
-  , altHighlight        :: Bool
-
-  , combineFun          :: CombineFun   -- tick-wise combine
-  , postFun             :: PostFun      --
-  , mergeModule         :: MergeFun     -- module-wise merge
-
-  , verbosity           :: Verbosity
-  }
-
-default_flags :: Flags
-default_flags = Flags
-  { outputFile          = "-"
-  , includeMods         = Set.empty
-  , excludeMods         = Set.empty
-  , hpcDirs             = [".hpc"]
-  , srcDirs             = []
-  , destDir             = "."
-
-  , perModule           = False
-  , decList             = False
-  , xmlOutput           = False
-
-  , funTotals           = False
-  , altHighlight        = False
-
-  , combineFun          = ADD
-  , postFun             = ID
-  , mergeModule         = INTERSECTION
-
-  , verbosity           = Normal
-  }
-
-
-data Verbosity = Silent | Normal | Verbose
-  deriving (Eq, Ord)
-
-verbosityFromString :: String -> Verbosity
-verbosityFromString "0" = Silent
-verbosityFromString "1" = Normal
-verbosityFromString "2" = Verbose
-verbosityFromString v   = error $ "unknown verbosity: " ++ v
-
-
--- 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 ["."]
-              else srcDirs flags
-  }
-
-type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)]
-
-noArg :: String -> String -> (Flags -> Flags) -> FlagOptSeq
-noArg flag detail fn = (:) $ Option [] [flag] (NoArg $ fn) detail
-
-anArg :: String -> String -> String -> (String -> Flags -> Flags) -> FlagOptSeq
-anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail
-
-infoArg :: String -> FlagOptSeq
-infoArg info = (:) $ Option [] [] (NoArg $ id) info
-
-excludeOpt, includeOpt, hpcDirOpt, resetHpcDirsOpt, srcDirOpt,
-    destDirOpt, outputOpt, verbosityOpt,
-    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 }
-
-includeOpt      = anArg "include"    "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"
-                $ \ a f -> f { includeMods = a `Set.insert` includeMods f }
-
-hpcDirOpt       = anArg "hpcdir"     "append sub-directory that contains .mix files" "DIR"
-                   (\ a f -> f { hpcDirs = hpcDirs f ++ [a] })
-                .  infoArg "default .hpc [rarely used]"
-
-resetHpcDirsOpt = noArg "reset-hpcdirs" "empty the list of hpcdir's"
-                   (\ f -> f { hpcDirs = [] })
-                .  infoArg "[rarely used]"
-
-srcDirOpt       = anArg "srcdir"     "path to source directory of .hs files" "DIR"
-                  (\ a f -> f { srcDirs = srcDirs f ++ [a] })
-                . infoArg "multi-use of srcdir possible"
-
-destDirOpt      = anArg "destdir"   "path to write output to" "DIR"
-                $ \ a f -> f { destDir = a }
-
-
-outputOpt     = anArg "output"    "output FILE" "FILE"        $ \ a f -> f { outputFile = a }
-
-verbosityOpt  = anArg "verbosity" "verbosity level, 0-2" "[0-2]"
-                (\ a f -> f { verbosity  = verbosityFromString a })
-              . infoArg "default 1"
-
--- markup
-
-perModuleOpt  = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True }
-decListOpt    = noArg "decl-list"  "show unused decls"        $ \ f -> f { decList = True }
-xmlOutputOpt  = noArg "xml-output" "show output in XML"       $ \ f -> f { xmlOutput = True }
-funTotalsOpt  = noArg "fun-entry-count" "show top-level function entry counts"
-                                                              $ \ f -> f { funTotals = True }
-altHighlightOpt
-              = noArg "highlight-covered" "highlight covered code, rather that code gaps"
-                                                              $ \ f -> f { altHighlight = True }
-
-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 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 }
-
-
--------------------------------------------------------------------------------
-
-readMixWithFlags :: Flags -> Either String TixModule -> IO Mix
-readMixWithFlags flags modu = readMix [ dir </> hpcDir
-                                      | dir <- srcDirs flags
-                                      , hpcDir <- hpcDirs 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 [])
-
-hpcError :: Plugin -> String -> IO a
-hpcError plugin msg = do
-   putStrLn $ "Error: " ++ msg
-   command_usage plugin
-   exitFailure
-
--------------------------------------------------------------------------------
-
-data Plugin = Plugin { name           :: String
-                     , usage          :: String
-                     , options        :: FlagOptSeq
-                     , summary        :: String
-                     , implementation :: Flags -> [String] -> IO ()
-                     , init_flags     :: Flags
-                     , final_flags    :: Flags -> Flags
-                     }
-
-------------------------------------------------------------------------------
-
--- filterModules takes a list of candidate modules,
--- and
---  * excludes the excluded modules
---  * includes the rest if there are no explicitly included modules
---  * otherwise, accepts just the included modules.
-
-allowModule :: Flags -> String -> Bool
-allowModule flags full_mod
-      | full_mod' `Set.member` excludeMods flags = False
-      | pkg_name  `Set.member` excludeMods flags = False
-      | mod_name  `Set.member` excludeMods flags = False
-      | Set.null (includeMods flags)             = True
-      | full_mod' `Set.member` includeMods flags = True
-      | pkg_name  `Set.member` includeMods flags = True
-      | mod_name  `Set.member` includeMods flags = True
-      | otherwise                                = False
-  where
-          full_mod' = pkg_name ++ mod_name
-      -- pkg name always ends with '/', main
-          (pkg_name,mod_name) =
-                        case span (/= '/') full_mod of
-                     (p,'/':m) -> (p ++ ":",m)
-                     (m,[])    -> (":",m)
-                     _         -> error "impossible case in allowModule"
-
-filterTix :: Flags -> Tix -> Tix
-filterTix flags (Tix tixs) =
-     Tix $ filter (allowModule flags . tixModuleName) tixs
-
-
-
-------------------------------------------------------------------------------
--- HpcCombine specifics
-
-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)
-
-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]
-           ]
-


=====================================
utils/hpc/HpcLexer.hs deleted
=====================================
@@ -1,57 +0,0 @@
-module HpcLexer where
-
-import Data.Char
-
-data Token
-        = ID String
-        | SYM Char
-        | INT Int
-        | STR String
-        | CAT String
-        deriving (Eq,Show)
-
-initLexer :: String -> [Token]
-initLexer str = [ t | (_,_,t) <- lexer str 1 1 ]
-
-lexer :: String -> Int -> Int ->  [(Int,Int,Token)]
-lexer (c:cs) line column
-  | c == '\n' = lexer cs (succ line) 1
-  | c == '\"' = lexerSTR cs line (succ column)
-  | c == '[' = lexerCAT cs "" line (succ column)
-  | c `elem` "{};-:"
-              = (line,column,SYM c) : lexer cs line (succ column)
-  | isSpace c = lexer cs        line (succ column)
-  | isAlpha c = lexerKW  cs [c] line (succ column)
-  | isDigit c = lexerINT cs [c] line (succ column)
-  | otherwise = error "lexer failure"
-lexer [] _ _ = []
-
-lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)]
-lexerKW  (c:cs) s line column
-  | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)
-lexerKW  other s line column = (line,column,ID s) : lexer other line column
-
-lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
-lexerINT  (c:cs) s line column
-  | isDigit c = lexerINT cs (s ++ [c]) line (succ column)
-lexerINT  other s line column = (line,column,INT (read s)) : lexer other line column
-
--- not technically correct for the new column count, but a good approximation.
-lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)]
-lexerSTR cs line column
-  = case lex ('"' : cs) of
-      [(str,rest)] -> (line,succ column,STR (read str))
-                   : lexer rest line (length (show str) + column + 1)
-      _ -> error "bad string"
-
-lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
-lexerCAT (c:cs) s line column
-  | c == ']'  =  (line,column,CAT s) : lexer cs line (succ column)
-  | otherwise = lexerCAT cs (s ++ [c]) line (succ column)
-lexerCAT  [] _ _ _ = error "lexer failure in CAT"
-
-test :: IO ()
-test = do
-          t <- readFile "EXAMPLE.tc"
-          print (initLexer t)
-


=====================================
utils/hpc/HpcMarkup.hs deleted
=====================================
@@ -1,485 +0,0 @@
----------------------------------------------------------
--- The main program for the hpc-markup tool, part of HPC.
--- Andy Gill and Colin Runciman, June 2006
----------------------------------------------------------
-
-module HpcMarkup (markup_plugin) where
-
-import Trace.Hpc.Mix
-import Trace.Hpc.Tix
-import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8)
-
-import HpcFlags
-import HpcUtils
-
-import System.FilePath
-import Data.List (sortBy, find)
-import Data.Maybe(fromJust)
-import Data.Semigroup as Semi
-import Data.Array
-import Control.Monad
-import qualified Data.Set as Set
-
-------------------------------------------------------------------------------
-
-markup_options :: FlagOptSeq
-markup_options
-        = excludeOpt
-        . includeOpt
-        . srcDirOpt
-        . hpcDirOpt
-        . resetHpcDirsOpt
-        . funTotalsOpt
-        . altHighlightOpt
-        . destDirOpt
-        . verbosityOpt
-
-markup_plugin :: Plugin
-markup_plugin = Plugin { name = "markup"
-                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
-                       , options = markup_options
-                       , summary = "Markup Haskell source with program coverage"
-                       , implementation = markup_main
-                       , init_flags = default_flags
-                       , final_flags = default_final_flags
-                       }
-
-------------------------------------------------------------------------------
-
-markup_main :: Flags -> [String] -> IO ()
-markup_main flags (prog:modNames) = do
-  let hpcflags1 = flags
-                { includeMods = Set.fromList modNames
-                                   `Set.union`
-                                includeMods flags }
-  let Flags
-       { funTotals = theFunTotals
-       , altHighlight = invertOutput
-       , destDir = dest_dir
-       }  = hpcflags1
-
-  mtix <- readTix (getTixFileName prog)
-  Tix tixs <- case mtix of
-    Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog
-    Just a -> return a
-
-  mods <-
-     sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput
-              | tix <- tixs
-              , allowModule hpcflags1 (tixModuleName tix)
-              ]
-
-  let index_name = "hpc_index"
-      index_fun  = "hpc_index_fun"
-      index_alt  = "hpc_index_alt"
-      index_exp  = "hpc_index_exp"
-
-  let writeSummary filename cmp = do
-        let mods' = sortBy cmp mods
-
-        unless (verbosity flags < Normal) $
-            putStrLn $ "Writing: " ++ (filename <.> "html")
-
-        writeFileUtf8 (dest_dir </> filename <.> "html") $
-            "<html>" ++
-            "<head>" ++
-            "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">" ++
-            "<style type=\"text/css\">" ++
-            "table.bar { background-color: #f25913; }\n" ++
-            "td.bar { background-color: #60de51;  }\n" ++
-            "td.invbar { background-color: #f25913;  }\n" ++
-            "table.dashboard { border-collapse: collapse  ; border: solid 1px black }\n" ++
-            ".dashboard td { border: solid 1px black }\n" ++
-            ".dashboard th { border: solid 1px black }\n" ++
-            "</style>\n" ++
-            "</head>" ++
-            "<body>" ++
-            "<table class=\"dashboard\" width=\"100%\" border=1>\n" ++
-            "<tr>" ++
-            "<th rowspan=2><a href=\"" ++ index_name ++ ".html\">module</a></th>" ++
-            "<th colspan=3><a href=\"" ++ index_fun ++ ".html\">Top Level Definitions</a></th>" ++
-            "<th colspan=3><a href=\"" ++ index_alt ++ ".html\">Alternatives</a></th>" ++
-            "<th colspan=3><a href=\"" ++ index_exp ++ ".html\">Expressions</a></th>" ++
-            "</tr>" ++
-            "<tr>" ++
-            "<th>%</th>" ++
-            "<th colspan=2>covered / total</th>" ++
-            "<th>%</th>" ++
-            "<th colspan=2>covered / total</th>" ++
-            "<th>%</th>" ++
-            "<th colspan=2>covered / total</th>" ++
-            "</tr>" ++
-            concat [ showModuleSummary (modName,fileName,modSummary)
-                   | (modName,fileName,modSummary) <- mods'
-                   ] ++
-            "<tr></tr>" ++
-            showTotalSummary (mconcat
-                                 [ modSummary
-                                 | (_,_,modSummary) <- mods'
-                                 ])
-                   ++ "</table></body></html>\n"
-
-  writeSummary index_name  $ \ (n1,_,_) (n2,_,_) -> compare n1 n2
-
-  writeSummary index_fun $ \ (_,_,s1) (_,_,s2) ->
-        compare (percent (topFunTicked s2) (topFunTotal s2))
-                (percent (topFunTicked s1) (topFunTotal s1))
-
-  writeSummary index_alt $ \ (_,_,s1) (_,_,s2) ->
-        compare (percent (altTicked s2) (altTotal s2))
-                (percent (altTicked s1) (altTotal s1))
-
-  writeSummary index_exp $ \ (_,_,s1) (_,_,s2) ->
-        compare (percent (expTicked s2) (expTotal s2))
-                (percent (expTicked s1) (expTotal s1))
-
-
-markup_main _ []
-    = hpcError markup_plugin $ "no .tix file or executable name specified"
-
--- Add characters to the left of a string until it is at least as
--- large as requested.
-padLeft :: Int -> Char -> String -> String
-padLeft n c str = go n str
-  where
-    -- If the string is already long enough, stop traversing it.
-    go 0 _       = str
-    go k []      = replicate k c ++ str
-    go k (_:xs)  = go (k-1) xs
-
-genHtmlFromMod
-  :: String
-  -> Flags
-  -> TixModule
-  -> Bool
-  -> Bool
-  -> IO (String, [Char], ModuleSummary)
-genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
-  let theHsPath = srcDirs flags
-  let modName0 = tixModuleName tix
-
-  (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix)
-
-  let arr_tix :: Array Int Integer
-      arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
-              $ tixModuleTixs tix
-
-  let tickedWith :: Int -> Integer
-      tickedWith n = arr_tix ! n
-
-      isTicked n = tickedWith n /= 0
-
-  let info = [ (pos,theMarkup)
-             | (gid,(pos,boxLabel)) <- zip [0 ..] mix'
-             , let binBox = case (isTicked gid,isTicked (gid+1)) of
-                               (False,False) -> []
-                               (True,False)  -> [TickedOnlyTrue]
-                               (False,True)  -> [TickedOnlyFalse]
-                               (True,True)   -> []
-             , let tickBox = if isTicked gid
-                             then [IsTicked]
-                             else [NotTicked]
-             , theMarkup <- case boxLabel of
-                                  ExpBox {} -> tickBox
-                                  TopLevelBox {}
-                                            -> TopLevelDecl theFunTotals (tickedWith gid) : tickBox
-                                  LocalBox {}   -> tickBox
-                                  BinBox _ True -> binBox
-                                  _             -> []
-             ]
-
-
-  let modSummary = foldr (.) id
-             [ \ st ->
-               case boxLabel of
-                 ExpBox False
-                        -> st { expTicked = ticked (expTicked st)
-                              , expTotal = succ (expTotal st)
-                              }
-                 ExpBox True
-                        -> st { expTicked = ticked (expTicked st)
-                              , expTotal = succ (expTotal st)
-                              , altTicked = ticked (altTicked st)
-                              , altTotal = succ (altTotal st)
-                              }
-                 TopLevelBox _ ->
-                           st { topFunTicked = ticked (topFunTicked st)
-                              , topFunTotal = succ (topFunTotal st)
-                              }
-                 _ -> st
-             | (gid,(_pos,boxLabel)) <- zip [0 ..] mix'
-             , let ticked = if isTicked gid
-                            then succ
-                            else id
-             ] $ mempty
-
-  -- add prefix to modName argument
-  content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath
-
-  let content' = markup tabStop info content
-  let addLine n xs = "<span class=\"lineno\">" ++ padLeft 5 ' ' (show n) ++ " </span>" ++ xs
-  let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines
-  let fileName = modName0 <.> "hs" <.> "html"
-  unless (verbosity flags < Normal) $
-            putStrLn $ "Writing: " ++ fileName
-  writeFileUtf8 (dest_dir </> fileName) $
-            unlines ["<html>",
-                     "<head>",
-                     "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">",
-                     "<style type=\"text/css\">",
-                     "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }",
-                     if invertOutput
-                     then "span.nottickedoff { color: #404040; background: white; font-style: oblique }"
-                     else "span.nottickedoff { background: " ++ yellow ++ "}",
-                     if invertOutput
-                     then "span.istickedoff { color: black; background: #d0c0ff; font-style: normal; }"
-                     else "span.istickedoff { background: white }",
-                     "span.tickonlyfalse { margin: -1px; border: 1px solid " ++ red ++ "; background: " ++ red ++ " }",
-                     "span.tickonlytrue  { margin: -1px; border: 1px solid " ++ green ++ "; background: " ++ green ++ " }",
-                     "span.funcount { font-size: small; color: orange; z-index: 2; position: absolute; right: 20 }",
-                     if invertOutput
-                     then "span.decl { font-weight: bold; background: #d0c0ff }"
-                     else "span.decl { font-weight: bold }",
-                     "span.spaces    { background: white }",
-                     "</style>",
-                     "</head>",
-                     "<body>",
-                     "<pre>",
-                     concat [
-                         "<span class=\"decl\">",
-                         "<span class=\"nottickedoff\">never executed</span> ",
-                         "<span class=\"tickonlytrue\">always true</span> ",
-                         "<span class=\"tickonlyfalse\">always false</span></span>"],
-                     "</pre>",
-                     "<pre>"] ++ addLines content' ++ "\n</pre>\n</body>\n</html>\n";
-
-
-  modSummary `seq` return (modName0,fileName,modSummary)
-
-data Loc = Loc !Int !Int
-         deriving (Eq,Ord,Show)
-
-data Markup
-     = NotTicked
-     | TickedOnlyTrue
-     | TickedOnlyFalse
-     | IsTicked
-     | TopLevelDecl
-           Bool     -- display entry totals
-           Integer
-     deriving (Eq,Show)
-
-markup    :: Int                -- ^tabStop
-          -> [(HpcPos,Markup)]  -- random list of tick location pairs
-          -> String             -- text to mark up
-          -> String
-markup tabStop mix str = addMarkup tabStop str (Loc 1 1) [] sortedTickLocs
-  where
-    tickLocs = [ (Loc ln1 c1,Loc ln2 c2,mark)
-               | (pos,mark) <- mix
-               , let (ln1,c1,ln2,c2) = fromHpcPos pos
-               ]
-    sortedTickLocs = sortBy (\(locA1,locZ1,_) (locA2,locZ2,_) ->
-                              (locA1,locZ2) `compare` (locA2,locZ1)) tickLocs
-
-addMarkup :: Int                -- tabStop
-          -> String             -- text to mark up
-          -> Loc                -- current location
-          -> [(Loc,Markup)]     -- stack of open ticks, with closing location
-          -> [(Loc,Loc,Markup)] -- sorted list of tick location pairs
-          -> String
-
--- check the pre-condition.
---addMarkup tabStop cs loc os ticks
---   | not (isSorted (map fst os)) = error $ "addMarkup: bad closing ordering: " ++ show os
-
---addMarkup tabStop cs loc os@(_:_) ticks
---   | trace (show (loc,os,take 10 ticks)) False = undefined
-
--- close all open ticks, if we have reached the end
-addMarkup _ [] _loc os [] =
-  concatMap (const closeTick) os
-addMarkup tabStop cs loc ((o,_):os) ticks | loc > o =
-  closeTick ++ addMarkup tabStop cs loc os ticks
-
---addMarkup tabStop cs loc os ((t1,t2,tik@(TopLevelDecl {})):ticks) | loc == t1 =
---   openTick tik ++ closeTick ++ addMarkup tabStop cs loc os ticks
-
-addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 =
-  case os of
-  ((_,tik'):_)
-    | not (allowNesting tik0 tik')
-    -> addMarkup tabStop cs loc os ticks -- already marked or bool within marked bool
-  _ -> openTick tik0 ++ addMarkup tabStop cs loc (addTo (t2,tik0) os) ticks
- where
-
-  addTo (t,tik) []             = [(t,tik)]
-  addTo (t,tik) ((t',tik'):xs) | t <= t'   = (t,tik):(t',tik'):xs
-                               | otherwise = (t',tik):(t',tik'):xs
-
-addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 =
-          -- throw away this tick, because it is from a previous place ??
-          addMarkup tabStop0 cs loc os ticks
-
-addMarkup tabStop0 ('\n':cs) loc@(Loc ln col) os@((Loc ln2 col2,_):_) ticks
-          | ln == ln2 && col < col2
-          = addMarkup tabStop0 (' ':'\n':cs) loc os ticks
-addMarkup tabStop0 (c0:cs) loc@(Loc _ p) os ticks =
-  if c0=='\n' && os/=[] then
-    concatMap (const closeTick) (downToTopLevel os) ++
-    c0 : "<span class=\"spaces\">" ++ expand 1 w ++ "</span>" ++
-    concatMap (openTick.snd) (reverse (downToTopLevel os)) ++
-    addMarkup tabStop0 cs' loc' os ticks
-  else if c0=='\t' then
-    expand p "\t" ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks
-  else
-    escape c0 ++ addMarkup tabStop0 cs (incBy c0 loc) os ticks
-  where
-  (w,cs') = span (`elem` " \t") cs
-  loc' = foldl (flip incBy) loc (c0:w)
-  escape '>' = ">"
-  escape '<' = "<"
-  escape '"' = """
-  escape '&' = "&"
-  escape c  = [c]
-
-  expand :: Int -> String -> String
-  expand _ ""       = ""
-  expand c ('\t':s) = replicate (c' - c) ' ' ++ expand c' s
-    where
-    c' = tabStopAfter 8 c
-  expand c (' ':s)  = ' ' : expand (c+1) s
-  expand _ _        = error "bad character in string for expansion"
-
-  incBy :: Char -> Loc -> Loc
-  incBy '\n' (Loc ln _c) = Loc (succ ln) 1
-  incBy '\t' (Loc ln c) = Loc ln (tabStopAfter tabStop0 c)
-  incBy _    (Loc ln c) = Loc ln (succ c)
-
-  tabStopAfter :: Int -> Int -> Int
-  tabStopAfter tabStop c = fromJust (find (>c) [1,(tabStop + 1)..])
-
-
-addMarkup tabStop cs loc os ticks = "ERROR: " ++ show (take 10 cs,tabStop,loc,take 10 os,take 10 ticks)
-
-openTick :: Markup -> String
-openTick NotTicked       = "<span class=\"nottickedoff\">"
-openTick IsTicked        = "<span class=\"istickedoff\">"
-openTick TickedOnlyTrue  = "<span class=\"tickonlytrue\">"
-openTick TickedOnlyFalse = "<span class=\"tickonlyfalse\">"
-openTick (TopLevelDecl False _) = openTopDecl
-openTick (TopLevelDecl True 0)
-         = "<span class=\"funcount\">-- never entered</span>" ++
-           openTopDecl
-openTick (TopLevelDecl True 1)
-         = "<span class=\"funcount\">-- entered once</span>" ++
-           openTopDecl
-openTick (TopLevelDecl True n0)
-         = "<span class=\"funcount\">-- entered " ++ showBigNum n0 ++ " times</span>" ++ openTopDecl
-  where showBigNum n | n <= 9999 = show n
-                     | otherwise = case n `quotRem` 1000 of
-                                     (q, r) -> showBigNum' q ++ "," ++ showWith r
-        showBigNum' n | n <= 999 = show n
-                      | otherwise = case n `quotRem` 1000 of
-                                      (q, r) -> showBigNum' q ++ "," ++ showWith r
-        showWith n = padLeft 3 '0' $ show n
-
-
-
-closeTick :: String
-closeTick = "</span>"
-
-openTopDecl :: String
-openTopDecl = "<span class=\"decl\">"
-
-downToTopLevel :: [(Loc,Markup)] -> [(Loc,Markup)]
-downToTopLevel ((_,TopLevelDecl {}):_) = []
-downToTopLevel (o : os)               = o : downToTopLevel os
-downToTopLevel []                     = []
-
-
--- build in logic for nesting bin boxes
-
-allowNesting :: Markup  -- innermost
-            -> Markup   -- outermost
-            -> Bool
-allowNesting n m               | n == m = False -- no need to double nest
-allowNesting IsTicked TickedOnlyFalse   = False
-allowNesting IsTicked TickedOnlyTrue    = False
-allowNesting _ _                        = True
-
-------------------------------------------------------------------------------
-
-data ModuleSummary = ModuleSummary
-     { expTicked :: !Int
-     , expTotal  :: !Int
-     , topFunTicked :: !Int
-     , topFunTotal  :: !Int
-     , altTicked :: !Int
-     , altTotal  :: !Int
-     }
-     deriving (Show)
-
-
-showModuleSummary :: (String, String, ModuleSummary) -> String
-showModuleSummary (modName,fileName,modSummary) =
-  "<tr>\n" ++
-  "<td>  <tt>module <a href=\"" ++ fileName ++ "\">"
-                              ++ modName ++ "</a></tt></td>\n" ++
-   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++
-   showSummary (altTicked modSummary) (altTotal modSummary) ++
-   showSummary (expTicked modSummary) (expTotal modSummary) ++
-  "</tr>\n"
-
-showTotalSummary :: ModuleSummary -> String
-showTotalSummary modSummary =
-  "<tr style=\"background: #e0e0e0\">\n" ++
-  "<th align=left>  Program Coverage Total</tt></th>\n" ++
-   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++
-   showSummary (altTicked modSummary) (altTotal modSummary) ++
-   showSummary (expTicked modSummary) (expTotal modSummary) ++
-  "</tr>\n"
-
-showSummary :: (Integral t, Show t) => t -> t -> String
-showSummary ticked total =
-                "<td align=\"right\">" ++ showP (percent ticked total) ++ "</td>" ++
-                "<td>" ++ show ticked ++ "/" ++ show total ++ "</td>" ++
-                "<td width=100>" ++
-                    (case percent ticked total of
-                       Nothing -> " "
-                       Just w -> bar w "bar"
-                     )  ++ "</td>"
-     where
-        showP Nothing = "- "
-        showP (Just x) = show x ++ "%"
-        bar 0 _     = bar 100 "invbar"
-        bar w inner = "<table cellpadding=0 cellspacing=0 width=\"100\" class=\"bar\">" ++
-                         "<tr><td><table cellpadding=0 cellspacing=0 width=\"" ++ show w ++ "%\">" ++
-                              "<tr><td height=12 class=" ++ show inner ++ "></td></tr>" ++
-                              "</table></td></tr></table>"
-
-percent :: (Integral a) => a -> a -> Maybe a
-percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total)
-
-instance Semi.Semigroup ModuleSummary where
-  (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1) <> (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)
-     = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)
-
-instance Monoid ModuleSummary where
-  mempty = ModuleSummary
-                  { expTicked = 0
-                  , expTotal  = 0
-                  , topFunTicked = 0
-                  , topFunTotal  = 0
-                  , altTicked = 0
-                  , altTotal  = 0
-                  }
-  mappend = (<>)
-
-------------------------------------------------------------------------------
--- global color palette
-
-red,green,yellow :: String
-red    = "#f20913"
-green  = "#60de51"
-yellow = "yellow"


=====================================
utils/hpc/HpcOverlay.hs deleted
=====================================
@@ -1,157 +0,0 @@
-module HpcOverlay where
-
-import HpcFlags
-import HpcParser
-import HpcUtils
-import Trace.Hpc.Tix
-import Trace.Hpc.Mix
-import Trace.Hpc.Util
-import qualified Data.Map as Map
-import Data.Tree
-
-overlay_options :: FlagOptSeq
-overlay_options
-        = srcDirOpt
-        . hpcDirOpt
-        . resetHpcDirsOpt
-        . outputOpt
-        . verbosityOpt
-
-overlay_plugin :: Plugin
-overlay_plugin = Plugin { name = "overlay"
-                       , usage = "[OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]]"
-                       , options = overlay_options
-                       , summary = "Generate a .tix file from an overlay file"
-                       , implementation = overlay_main
-                       , init_flags = default_flags
-                       , final_flags = default_final_flags
-                       }
-
-overlay_main :: Flags -> [String] -> IO ()
-overlay_main _     [] = hpcError overlay_plugin $ "no overlay file specified"
-overlay_main flags files = do
-  specs <- mapM hpcParser files
-  let (Spec globals modules) = concatSpec specs
-
-  let modules1 = Map.fromListWith (++) [ (m,info) | (m,info) <- modules ]
-
-  mod_info <-
-     sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu)
-                   content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags)
-                   processModule modu content mix mod_spec globals
-              | (modu, mod_spec) <- Map.toList modules1
-              ]
-
-
-  let tix = Tix $ mod_info
-
-  case outputFile flags of
-    "-" -> putStrLn (show tix)
-    out -> writeFile out (show tix)
-
-
-processModule :: String         -- ^ module name
-              -> String         -- ^ module contents
-              -> Mix            -- ^ mix entry for this module
-              -> [Tick]         -- ^ local ticks
-              -> [ExprTick]     -- ^ global ticks
-              -> IO TixModule
-processModule modName modContents (Mix _ _ hash _ entries) locals globals = do
-
-   let hsMap :: Map.Map Int String
-       hsMap = Map.fromList (zip [1..] $ lines modContents)
-
-   let topLevelFunctions =
-        Map.fromListWith (++)
-                     [ (nm,[pos])
-                     | (pos,TopLevelBox [nm]) <- entries
-                     ]
-
-   let inside :: HpcPos -> String -> Bool
-       inside pos nm =
-                       case Map.lookup nm topLevelFunctions of
-                         Nothing -> False
-                         Just poss -> any (pos `insideHpcPos`) poss
-
-   -- TODO: rename plzTick => plzExprTick, plzTopPick => plzTick
-   let plzTick :: HpcPos -> BoxLabel -> ExprTick -> Bool
-       plzTick pos (ExpBox _) (TickExpression _ match q _)  =
-                     qualifier pos q
-                  && case match of
-                        Nothing -> True
-                        Just str -> str == grabHpcPos hsMap pos
-       plzTick _   _       _ = False
-
-
-       plzTopTick :: HpcPos -> BoxLabel -> Tick -> Bool
-       plzTopTick pos label  (ExprTick ignore)           = plzTick pos label ignore
-       plzTopTick pos _      (TickFunction fn q _)   =
-                    qualifier pos q && pos `inside` fn
-       plzTopTick pos label  (InsideFunction fn igs)   =
-         pos `inside` fn && any (plzTopTick pos label) igs
-
-
-   let tixs = Map.fromList
-              [ (ix,
-                   any (plzTick pos label) globals
-                || any (plzTopTick pos label) locals)
-              | (ix,(pos,label)) <- zip [0..] entries
-              ]
-
-
-   -- let show' (srcspan,stuff) = show (srcspan,stuff,grabHpcPos hsMap span)
-
-   let forest = createMixEntryDom
-              [ (srcspan,ix)
-              | ((srcspan,_),ix) <- zip entries [0..]
-              ]
-
-
-   --
-   let forest2 = addParentToList [] $ forest
---   putStrLn $ drawForest $ map (fmap show') $ forest2
-
-   let isDomList = Map.fromList
-              [ (ix,filter (/= ix) rng ++ dom)
-              | (_,(rng,dom)) <- concatMap flatten forest2
-              , ix <- rng
-              ]
-
-   -- We do not use laziness here, because the dominator lists
-   -- point to their equivent peers, creating loops.
-
-
-   let isTicked n =
-           case Map.lookup n tixs of
-             Just v -> v
-             Nothing -> error $ "can not find ix # " ++ show n
-
-   let tixs' = [ case Map.lookup n isDomList of
-                   Just vs -> if any isTicked (n : vs) then 1 else 0
-                   Nothing -> error $ "can not find ix in dom list # " ++ show n
-               | n <- [0..(length entries - 1)]
-               ]
-
-   return $ TixModule modName hash (length tixs') tixs'
-
-qualifier :: HpcPos -> Maybe Qualifier -> Bool
-qualifier _   Nothing = True
-qualifier pos (Just (OnLine n)) = n == l1 && n == l2
-  where (l1,_,l2,_) = fromHpcPos pos
-qualifier pos (Just (AtPosition l1' c1' l2' c2'))
-          = (l1', c1', l2', c2') == fromHpcPos pos
-
-concatSpec :: [Spec] -> Spec
-concatSpec = foldr
-               (\ (Spec pre1 body1) (Spec pre2 body2)
-                     -> Spec (pre1 ++ pre2) (body1 ++ body2))
-                (Spec [] [])
-
-
-
-addParentToTree :: [a] -> MixEntryDom [a] -> MixEntryDom ([a],[a])
-addParentToTree path (Node (pos,a) children) =
-                Node (pos,(a,path)) (addParentToList (a ++ path) children)
-
-addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])]
-addParentToList path nodes = map (addParentToTree path) nodes


=====================================
utils/hpc/HpcParser.y deleted
=====================================
@@ -1,106 +0,0 @@
-{ 
-module HpcParser where
-
-import HpcLexer
-}
-
-%name parser
-%expect 0
-%tokentype { Token }
-
-%token
-	MODULE 		{ ID "module" }
-	TICK		{ ID "tick" }
-	EXPRESSION	{ ID "expression" }
-	ON		{ ID "on" }
-	LINE		{ ID "line" }
-	POSITION	{ ID "position" }
-	FUNCTION	{ ID "function" }
-	INSIDE          { ID "inside" }
-	AT		{ ID "at" }
-	':'		{ SYM ':' }
-	'-'		{ SYM '-' }
-	';'		{ SYM ';' }
-	'{'		{ SYM '{' }
-	'}'		{ SYM '}' }
-	int		{ INT $$ }
-	string		{ STR $$ }
-	cat		{ CAT $$ }
-%%
-
-Spec    :: { Spec }
-Spec 	: Ticks Modules 	{ Spec ($1 []) ($2 []) }
-
-Modules :: { L (ModuleName,[Tick]) }
-Modules	: Modules Module	{ $1 . ((:) $2) }
-	|			{ id }
-	
-Module :: { (ModuleName,[Tick]) }
-Module  : MODULE string '{' TopTicks '}'
-				{ ($2,$4 []) }
-
-TopTicks :: { L Tick }
-TopTicks : TopTicks TopTick	{ $1 . ((:) $2) }
-	 | 			{ id }
-	
-TopTick :: { Tick }
-TopTick : Tick			{ ExprTick $1 }
-	| TICK FUNCTION string optQual optCat ';'
-				{ TickFunction $3 $4 $5 }
-	| INSIDE string '{' TopTicks '}'
-				{ InsideFunction $2 ($4 []) }
-				 
-Ticks   :: { L ExprTick }
-Ticks   : Ticks  Tick          	{ $1 . ((:) $2) }
-	|  		       	{ id } 
-	
-Tick   :: { ExprTick }
-Tick    : TICK optString optQual optCat ';'
-				{ TickExpression False $2 $3 $4 }
-
-optString :: { Maybe String }
-optString : string		{ Just $1 }
-	  |			{ Nothing }
-	
-optQual :: { Maybe Qualifier }
-optQual : ON LINE int 		{ Just (OnLine $3) }
-	| AT POSITION int ':' int '-' int ':' int
-				{ Just (AtPosition $3 $5 $7 $9) }
-	| 			{ Nothing }
-optCat  :: { Maybe String }
-optCat  : cat			{ Just $1 }
-	| 			{ Nothing }
-
-{
-type L a = [a] -> [a]
-	
-type ModuleName = String
-
-data Spec 
-  = Spec [ExprTick] [(ModuleName,[Tick])]
-   deriving (Show)
-
-data ExprTick
-  = TickExpression Bool (Maybe String) (Maybe Qualifier) (Maybe String)
-   deriving (Show)
-
-data Tick
-  = ExprTick ExprTick
-  | TickFunction   String (Maybe Qualifier) (Maybe String)
-  | InsideFunction String [Tick]
-   deriving (Show)
-
-data Qualifier = OnLine Int
-               | AtPosition Int Int Int Int
-   deriving (Show)             
-
-
-
-hpcParser :: String -> IO Spec
-hpcParser filename = do
-  txt <- readFile filename
-  let tokens = initLexer txt
-  return $ parser tokens  	
-
-happyError e = error $ show (take 10 e)
-}


=====================================
utils/hpc/HpcReport.hs deleted
=====================================
@@ -1,277 +0,0 @@
----------------------------------------------------------
--- The main program for the hpc-report tool, part of HPC.
--- Colin Runciman and Andy Gill, June 2006
----------------------------------------------------------
-
-module HpcReport (report_plugin) where
-
-import Prelude hiding (exp)
-import Data.List(sort,intersperse,sortBy)
-import HpcFlags
-import Trace.Hpc.Mix
-import Trace.Hpc.Tix
-import Control.Monad hiding (guard)
-import qualified Data.Set as Set
-
-notExpecting :: String -> a
-notExpecting s = error ("not expecting "++s)
-
-data BoxTixCounts = BT {boxCount, tixCount :: !Int}
-
-btZero :: BoxTixCounts
-btZero = BT {boxCount=0, tixCount=0}
-
-btPlus :: BoxTixCounts -> BoxTixCounts -> BoxTixCounts
-btPlus (BT b1 t1) (BT b2 t2) = BT (b1+b2) (t1+t2)
-
-btPercentage :: String -> BoxTixCounts -> String
-btPercentage s (BT b t) = showPercentage s t b
-
-showPercentage :: String -> Int -> Int -> String
-showPercentage s 0 0 = "100% "++s++" (0/0)"
-showPercentage s n d = showWidth 3 p++"% "++
-                       s++
-                       " ("++show n++"/"++show d++")"
-  where
-  p = (n*100) `div` d
-  showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx
-                  where
-                  sx = show x0
-                  shortOf x y = if y < x then x-y else 0
-
-data BinBoxTixCounts = BBT { binBoxCount
-                           , onlyTrueTixCount
-                           , onlyFalseTixCount
-                           , bothTixCount :: !Int}
-
-bbtzero :: BinBoxTixCounts
-bbtzero = BBT { binBoxCount=0
-              , onlyTrueTixCount=0
-              , onlyFalseTixCount=0
-              , bothTixCount=0}
-
-bbtPlus :: BinBoxTixCounts -> BinBoxTixCounts -> BinBoxTixCounts
-bbtPlus (BBT b1 tt1 ft1 bt1) (BBT b2 tt2 ft2 bt2) =
-  BBT (b1+b2) (tt1+tt2) (ft1+ft2) (bt1+bt2)
-
-bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String
-bbtPercentage s withdetail (BBT b tt ft bt) =
-  showPercentage s bt b ++
-  if withdetail && bt/=b then
-    detailFor tt "always True"++
-    detailFor ft "always False"++
-    detailFor (b-(tt+ft+bt)) "unevaluated"
-  else ""
-  where
-  detailFor n txt = if n>0 then ", "++show n++" "++txt
-                    else ""
-
-data ModInfo = MI { exp,alt,top,loc :: !BoxTixCounts
-                  , guard,cond,qual :: !BinBoxTixCounts
-                  , decPaths :: [[String]]}
-
-miZero :: ModInfo
-miZero = MI { exp=btZero
-            , alt=btZero
-            , top=btZero
-            , loc=btZero
-            , guard=bbtzero
-            , cond=bbtzero
-            , qual=bbtzero
-            , decPaths = []}
-
-miPlus :: ModInfo -> ModInfo -> ModInfo
-miPlus mi1 mi2 =
-  MI { exp = exp mi1 `btPlus` exp mi2
-     , alt = alt mi1 `btPlus` alt mi2
-     , top = top mi1 `btPlus` top mi2
-     , loc = loc mi1 `btPlus` loc mi2
-     , guard = guard mi1 `bbtPlus` guard mi2
-     , cond  = cond  mi1 `bbtPlus` cond  mi2
-     , qual  = qual  mi1 `bbtPlus` qual  mi2
-     , decPaths = decPaths mi1 ++ decPaths mi2 }
-
-allBinCounts :: ModInfo -> BinBoxTixCounts
-allBinCounts mi =
-  BBT { binBoxCount = sumAll binBoxCount
-      , onlyTrueTixCount = sumAll onlyTrueTixCount
-      , onlyFalseTixCount = sumAll onlyFalseTixCount
-      , bothTixCount = sumAll bothTixCount }
-  where
-  sumAll f = f (guard mi) + f (cond mi) + f (qual mi)
-
-accumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo
-accumCounts [] mi = mi
-accumCounts ((bl,btc):etc) mi
- | single bl = accumCounts etc mi'
-  where
-  mi' = case bl of
-        ExpBox False ->   mi{exp = inc (exp mi)}
-        ExpBox True  ->   mi{exp = inc (exp mi), alt = inc (alt mi)}
-        TopLevelBox dp -> mi{top = inc (top mi)
-                            ,decPaths = upd dp (decPaths mi)}
-        LocalBox dp ->    mi{loc = inc (loc mi)
-                            ,decPaths = upd dp (decPaths mi)}
-        _other ->          notExpecting "BoxLabel in accumcounts"
-  inc (BT {boxCount=bc,tixCount=tc}) =
-    BT { boxCount = bc+1
-       , 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
-  mi' = case (bl0,bl1) of
-        (BinBox GuardBinBox True, BinBox GuardBinBox False) ->
-          mi{guard = inc (guard mi)}
-        (BinBox CondBinBox True, BinBox CondBinBox False) ->
-          mi{cond = inc (cond mi)}
-        (BinBox QualBinBox True, BinBox QualBinBox False) ->
-          mi{qual = inc (qual mi)}
-        _other -> notExpecting "BoxLabel pair in accumcounts"
-  inc (BBT { binBoxCount=bbc
-           , onlyTrueTixCount=ttc
-           , onlyFalseTixCount=ftc
-           , bothTixCount=btc}) =
-    BBT { binBoxCount       = bbc+1
-        , onlyTrueTixCount  = ttc + bit (btc0 >0 && btc1==0)
-        , onlyFalseTixCount = ftc + bit (btc0==0 && btc1 >0)
-        , bothTixCount      = btc + bit (btc0 >0 && btc1 >0) }
-
-bit :: Bool -> Int
-bit True = 1
-bit False = 0
-
-single :: BoxLabel -> Bool
-single (ExpBox {}) = True
-single (TopLevelBox _) = True
-single (LocalBox _) = True
-single (BinBox {}) = False
-
-modInfo :: Flags -> Bool -> TixModule -> IO ModInfo
-modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
-  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 _ _ _) = do
-  mi <- modInfo hpcflags False tix
-  if xmlOutput hpcflags
-    then putStrLn $ "  <module name = " ++ show moduleName  ++ ">"
-    else putStrLn ("-----<module "++moduleName++">-----")
-  printModInfo hpcflags mi
-  if xmlOutput hpcflags
-    then putStrLn $ "  </module>"
-    else return ()
-
-printModInfo :: Flags -> ModInfo -> IO ()
-printModInfo hpcflags mi | xmlOutput hpcflags = do
-  element "exprs" (xmlBT $ exp mi)
-  element "booleans" (xmlBBT $ allBinCounts mi)
-  element "guards" (xmlBBT $ guard mi)
-  element "conditionals" (xmlBBT $ cond mi)
-  element "qualifiers" (xmlBBT $ qual mi)
-  element "alts" (xmlBT $ alt mi)
-  element "local" (xmlBT $ loc mi)
-  element "toplevel" (xmlBT $ top mi)
-printModInfo hpcflags mi = do
-  putStrLn (btPercentage "expressions used" (exp mi))
-  putStrLn (bbtPercentage "boolean coverage" False (allBinCounts mi))
-  putStrLn ("     "++bbtPercentage "guards" True (guard mi))
-  putStrLn ("     "++bbtPercentage "'if' conditions" True (cond mi))
-  putStrLn ("     "++bbtPercentage "qualifiers" True (qual mi))
-  putStrLn (btPercentage "alternatives used" (alt mi))
-  putStrLn (btPercentage "local declarations used" (loc mi))
-  putStrLn (btPercentage "top-level declarations used" (top mi))
-  modDecList hpcflags mi
-
-modDecList :: Flags -> ModInfo -> IO ()
-modDecList hpcflags mi0 =
-  when (decList hpcflags && someDecsUnused mi0) $ do
-    putStrLn "unused declarations:"
-    mapM_ showDecPath (sort (decPaths mi0))
-  where
-  someDecsUnused mi = tixCount (top mi) < boxCount (top mi) ||
-                      tixCount (loc mi) < boxCount (loc mi)
-  showDecPath dp = putStrLn ("     "++
-                             concat (intersperse "." dp))
-
-report_plugin :: Plugin
-report_plugin = Plugin { name = "report"
-                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
-                       , options = report_options
-                       , summary = "Output textual report about program coverage"
-                       , implementation = report_main
-                       , init_flags = default_flags
-                       , final_flags = default_final_flags
-                       }
-
-report_main :: Flags -> [String] -> IO ()
-report_main hpcflags (progName:mods) = do
-  let hpcflags1 = hpcflags
-                { includeMods = Set.fromList mods
-                                   `Set.union`
-                                includeMods hpcflags }
-  let prog = getTixFileName $ progName
-  tix <- readTix prog
-  case tix of
-    Just (Tix tickCounts) ->
-           makeReport hpcflags1 progName
-                    $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)
-                    $ [ tix'
-                      | tix'@(TixModule m _ _ _) <- tickCounts
-                      , allowModule hpcflags1 m
-                      ]
-    Nothing -> hpcError report_plugin  $ "unable to find tix file for:" ++ progName
-report_main _ [] =
-        hpcError report_plugin $ "no .tix file or executable name specified"
-
-makeReport :: Flags -> String -> [TixModule] -> IO ()
-makeReport hpcflags progName modTcs | xmlOutput hpcflags = do
-  putStrLn $ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
-  putStrLn $ "<coverage name=" ++ show progName ++ ">"
-  if perModule hpcflags
-    then mapM_ (modReport hpcflags) modTcs
-    else return ()
-  mis <- mapM (modInfo hpcflags True) modTcs
-  putStrLn $ "  <summary>"
-  printModInfo hpcflags (foldr miPlus miZero mis)
-  putStrLn $ "  </summary>"
-  putStrLn $ "</coverage>"
-makeReport hpcflags _ modTcs =
-  if perModule hpcflags then
-    mapM_ (modReport hpcflags) modTcs
-  else do
-    mis <- mapM (modInfo hpcflags True) modTcs
-    printModInfo hpcflags (foldr miPlus miZero mis)
-
-element :: String -> [(String,String)] -> IO ()
-element tag attrs = putStrLn $
-                    "    <" ++ tag ++ " "
-                        ++ unwords [ x ++ "=" ++ show y
-                                   | (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
-        . excludeOpt
-        . includeOpt
-        . srcDirOpt
-        . hpcDirOpt
-        . resetHpcDirsOpt
-        . xmlOutputOpt
-        . verbosityOpt


=====================================
utils/hpc/HpcShowTix.hs deleted
=====================================
@@ -1,63 +0,0 @@
-module HpcShowTix (showtix_plugin) where
-
-import Trace.Hpc.Mix
-import Trace.Hpc.Tix
-
-import HpcFlags
-
-import qualified Data.Set as Set
-
-showtix_options :: FlagOptSeq
-showtix_options
-        = excludeOpt
-        . includeOpt
-        . srcDirOpt
-        . hpcDirOpt
-        . resetHpcDirsOpt
-        . outputOpt
-        . verbosityOpt
-
-showtix_plugin :: Plugin
-showtix_plugin = Plugin { name = "show"
-                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
-                       , options = showtix_options
-                       , summary = "Show .tix file in readable, verbose format"
-                       , implementation = showtix_main
-                       , init_flags = default_flags
-                       , final_flags = default_final_flags
-                       }
-
-
-showtix_main :: Flags -> [String] -> IO ()
-showtix_main _     [] = hpcError showtix_plugin $ "no .tix file or executable name specified"
-showtix_main flags (prog:modNames) = do
-  let hpcflags1 = flags
-                { includeMods = Set.fromList modNames
-                                   `Set.union`
-                                includeMods flags }
-
-  optTixs <- readTix (getTixFileName prog)
-  case optTixs of
-    Nothing -> hpcError showtix_plugin $ "could not read .tix file : "  ++ prog
-    Just (Tix tixs) -> do
-       tixs_mixs <- sequence
-               [ do mix <- readMixWithFlags hpcflags1 (Right tix)
-                    return $ (tix,mix)
-               | tix <- tixs
-               , allowModule hpcflags1 (tixModuleName tix)
-               ]
-
-       let rjust n str = take (n - length str) (repeat ' ') ++ str
-       let ljust n str = str ++ take (n - length str) (repeat ' ')
-
-       sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++
-                                         rjust 10 (show count) ++ " " ++
-                                         ljust 20  modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab)
-                             | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries
-                             ]
-                 | ( TixModule modName _hash1 _ tixs'
-                   , Mix _file _timestamp _hash2 _tab entries
-                   ) <- tixs_mixs
-                 ]
-
-       return ()


=====================================
utils/hpc/HpcUtils.hs deleted
=====================================
@@ -1,37 +0,0 @@
-module HpcUtils where
-
-import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8)
-import qualified Data.Map as Map
-import System.FilePath
-
-dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
--- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse
-dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []
-
--- turns \n into ' '
--- | grab's the text behind a HpcPos; 
-grabHpcPos :: Map.Map Int String -> HpcPos -> String
-grabHpcPos hsMap srcspan = 
-         case lns of
-           [] -> error "grabHpcPos: invalid source span"
-           [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)
-           hd : tl ->
-                let lns1 = drop (c1 -1) hd : tl
-                    lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]
-                 in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2
-  where (l1,c1,l2,c2) = fromHpcPos srcspan
-        lns = map (\ n -> case Map.lookup n hsMap of
-                           Just ln -> ln
-                           Nothing -> error $ "bad line number : " ++ show n
-                  ) [l1..l2]
-
-
-readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
-readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename
-readFileFromPath err filename path0 = readTheFile path0
-  where
-        readTheFile [] = err $ "could not find " ++ show filename
-                                 ++ " in path " ++ show path0
-        readTheFile (dir:dirs) =
-                catchIO (readFileUtf8 (dir </> filename))
-                        (\ _ -> readTheFile dirs)


=====================================
utils/hpc/Main.hs deleted
=====================================
@@ -1,217 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
--- (c) 2007 Andy Gill
-
--- Main driver for Hpc
-import Control.Monad (forM, forM_, when)
-import Data.Bifunctor (bimap)
-import Data.List (intercalate, partition, uncons)
-import Data.List.NonEmpty (NonEmpty((:|)))
-import Data.Maybe (catMaybes, isJust)
-import Data.Version
-import System.Environment
-import System.Exit
-import System.Console.GetOpt
-import System.Directory (doesPathExist)
-
-import HpcFlags
-import HpcReport
-import HpcMarkup
-import HpcCombine
-import HpcShowTix
-import HpcDraft
-import HpcOverlay
-import Paths_hpc_bin
-
-helpList :: IO ()
-helpList = do
-     putStrLn $
-           "Usage: hpc COMMAND ...\n\n" ++
-           section "Commands" help ++
-           section "Reporting Coverage" reporting ++
-           section "Processing Coverage files" processing ++
-           section "Coverage Overlays" overlays ++
-           section "Others" other ++
-           ""
-     putStrLn ""
-     putStrLn "or: hpc @response_file_1 @response_file_2 ..."
-     putStrLn ""
-     putStrLn "The contents of a Response File must have this format:"
-     putStrLn "COMMAND ..."
-     putStrLn ""
-     putStrLn "example:"
-     putStrLn "report my_library.tix --include=ModuleA \\"
-     putStrLn "--include=ModuleB"
-  where
-    help       = ["help"]
-    reporting  = ["report","markup"]
-    overlays   = ["overlay","draft"]
-    processing = ["sum","combine","map"]
-    other     = [ name hook
-                | hook <- hooks
-                , name hook `notElem`
-                     (concat [help,reporting,processing,overlays])
-                ]
-
-section :: String -> [String] -> String
-section _   []   = ""
-section msg cmds = msg ++ ":\n"
-        ++ unlines [ take 14 ("  " ++ cmd ++ repeat ' ') ++ summary hook
-                   | cmd <- cmds
-                   , hook <- hooks
-                   , name hook == cmd
-                   ]
-
-dispatch :: [String] -> IO ()
-dispatch [] = do
-    helpList
-    exitWith ExitSuccess
-dispatch (txt:args0) = do
-    case lookup txt hooks' of
-      Just plugin -> parse plugin args0
-      _ -> case getResponseFileName txt of
-        Nothing -> parse help_plugin (txt:args0)
-        Just firstResponseFileName -> do
-          let
-            (responseFileNames', nonResponseFileNames) = partitionFileNames args0
-          -- if arguments are combination of Response Files and non-Response Files, exit with error
-          when (length nonResponseFileNames > 0) $ do
-            let
-            putStrLn $ "First argument '" <> txt <> "' is a Response File, " <>
-              "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'"
-            putStrLn $ "When first argument is a Response File, " <>
-              "all arguments should be Response Files."
-            exitFailure
-          let
-            responseFileNames :: NonEmpty FilePath
-            responseFileNames = firstResponseFileName :| responseFileNames'
-
-          forM_ responseFileNames $ \responseFileName -> do
-            exists <- doesPathExist responseFileName
-            when (not exists) $ do
-              putStrLn $ "Response File '" <> responseFileName <> "' does not exist"
-              exitFailure
-
-          -- read all Response Files
-          responseFileNamesAndText :: NonEmpty (FilePath, String) <-
-            forM responseFileNames $ \responseFileName ->
-              fmap (responseFileName, ) (readFile responseFileName)
-          forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) ->
-            -- parse first word of Response File, which should be a command
-            case uncons $ words responseFileText of
-              Nothing -> do
-                putStrLn $ "Response File '" <> responseFileName <> "' has no command"
-                exitFailure
-              Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of
-                -- check command for validity
-                -- It is important than a Response File cannot specify another Response File;
-                -- this is prevented
-                Nothing -> do
-                  putStrLn $ "Response File '" <> responseFileName <>
-                    "' command '" <> responseFileCommand <> "' invalid"
-                  exitFailure
-                Just plugin -> do
-                  putStrLn $ "Response File '" <> responseFileName <> "':"
-                  parse plugin args1
-
-  where
-     getResponseFileName :: String -> Maybe FilePath
-     getResponseFileName s = do
-       (firstChar, filename) <- uncons s
-       if firstChar == '@'
-         then pure filename
-         else Nothing
-
-     -- first member of tuple is list of Response File names,
-     -- second member of tuple is list of all other arguments
-     partitionFileNames :: [String] -> ([FilePath], [String])
-     partitionFileNames xs = let
-       hasFileName :: [(String, Maybe FilePath)]
-       hasFileName = fmap (\x -> (x, getResponseFileName x)) xs
-       (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) =
-         bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName
-       in (catMaybes fileNames, nonFileNames)
-
-     parse plugin args =
-              case getOpt Permute (options plugin []) args of
-                (_,_,errs) | not (null errs)
-                     -> do putStrLn "hpc failed:"
-                           sequence_ [ putStr ("  " ++ err)
-                                    | err <- errs
-                                    ]
-                           putStrLn $ "\n"
-                           command_usage plugin
-                           exitFailure
-                (o,ns,_) -> do
-                         let flags = final_flags plugin
-                                   . foldr (.) id o
-                                   $ init_flags plugin
-                         implementation plugin flags ns
-
-main :: IO ()
-main = do
- args <- getArgs
- dispatch args
-
-------------------------------------------------------------------------------
-
-hooks :: [Plugin]
-hooks = [ help_plugin
-        , report_plugin
-        , markup_plugin
-        , sum_plugin
-        , combine_plugin
-        , map_plugin
-        , showtix_plugin
-        , overlay_plugin
-        , draft_plugin
-        , version_plugin
-        ]
-
-hooks' :: [(String, Plugin)]
-hooks' = [ (name hook,hook) | hook <- hooks ]
-
-------------------------------------------------------------------------------
-
-help_plugin :: Plugin
-help_plugin = Plugin { name = "help"
-                     , usage = "[<HPC_COMMAND>]"
-                     , summary = "Display help for hpc or a single command"
-                     , options = help_options
-                     , implementation = help_main
-                     , init_flags = default_flags
-                     , final_flags = default_final_flags
-                     }
-
-help_main :: Flags -> [String] -> IO ()
-help_main _ [] = do
-            helpList
-            exitWith ExitSuccess
-help_main _ (sub_txt:_) = do
-    case lookup sub_txt hooks' of
-      Nothing -> do
-          putStrLn $ "no such HPC command: " <> sub_txt
-          exitFailure
-      Just plugin' -> do
-          command_usage plugin'
-          exitWith ExitSuccess
-
-help_options :: FlagOptSeq
-help_options   = id
-
-------------------------------------------------------------------------------
-
-version_plugin :: Plugin
-version_plugin = Plugin { name = "version"
-                        , usage = ""
-                        , summary = "Display version for hpc"
-                        , options = id
-                        , implementation = version_main
-                        , init_flags = default_flags
-                        , final_flags = default_final_flags
-                        }
-
-version_main :: Flags -> [String] -> IO ()
-version_main _ _ = putStrLn ("hpc tools, version " ++ showVersion version)
-
-
-------------------------------------------------------------------------------


=====================================
utils/hpc/Makefile deleted
=====================================
@@ -1,15 +0,0 @@
-# -----------------------------------------------------------------------------
-#
-# (c) 2009 The University of Glasgow
-#
-# This file is part of the GHC build system.
-#
-# To understand how the build system works and how to modify it, see
-#      https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture
-#      https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying
-#
-# -----------------------------------------------------------------------------
-
-dir = utils/hpc
-TOP = ../..
-include $(TOP)/mk/sub-makefile.mk


=====================================
utils/hpc/hpc-bin.cabal deleted
=====================================
@@ -1,44 +0,0 @@
-Name: hpc-bin
--- XXX version number:
-Version: 0.68
-Copyright: XXX
-License: BSD3
--- XXX License-File: LICENSE
-Author: XXX
-Maintainer: XXX
-Synopsis: XXX
-Description: XXX
-Category: Development
-build-type: Simple
-cabal-version: 2.0
-
-Flag build-tool-depends
-    Description: Use build-tool-depends
-    Default: True
-
-Executable hpc
-    Default-Language: Haskell2010
-    Main-Is: Main.hs
-    Other-Modules: HpcParser
-                   HpcCombine
-                   HpcDraft
-                   HpcFlags
-                   HpcLexer
-                   HpcMarkup
-                   HpcOverlay
-                   HpcReport
-                   HpcShowTix
-                   HpcUtils
-                   Paths_hpc_bin
-
-    autogen-modules: Paths_hpc_bin
-
-    Build-Depends: base       >= 4   && < 5,
-                   directory  >= 1   && < 1.4,
-                   filepath   >= 1   && < 1.5,
-                   containers >= 0.1 && < 0.7,
-                   array      >= 0.1 && < 0.6,
-                   hpc        >= 0.6.1 && < 0.7
-
-    if flag(build-tool-depends)
-      build-tool-depends: happy:happy >= 1.20.0


=====================================
utils/hpc/hpc.wrapper deleted
=====================================
@@ -1,2 +0,0 @@
-#!/bin/sh
-exec "$executablename" ${1+"$@"}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2aa0770845631e4355f55694f49b3e4b66ecf751...606793d424b08971f1eea4f1fae84b89297e1e63

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2aa0770845631e4355f55694f49b3e4b66ecf751...606793d424b08971f1eea4f1fae84b89297e1e63
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230308/bc6a3da3/attachment-0001.html>


More information about the ghc-commits mailing list