diff options
m--------- | libraries/hpc | 0 | ||||
-rw-r--r-- | utils/hpc/HpcCombine.hs | 10 | ||||
-rw-r--r-- | utils/hpc/HpcDraft.hs | 4 | ||||
-rw-r--r-- | utils/hpc/HpcMarkup.hs | 4 | ||||
-rw-r--r-- | utils/hpc/HpcOverlay.hs | 2 | ||||
-rw-r--r-- | utils/hpc/HpcReport.hs | 8 | ||||
-rw-r--r-- | utils/hpc/HpcShowTix.hs | 4 |
7 files changed, 18 insertions, 14 deletions
diff --git a/libraries/hpc b/libraries/hpc -Subproject 8e18f01d643bd00eae41a7fc72465d7c7d2790b +Subproject 1fbe30eb515ac67945c3075c92e7bbe69f64d11 diff --git a/utils/hpc/HpcCombine.hs b/utils/hpc/HpcCombine.hs index ab4b4dd15c..0053fbbf8d 100644 --- a/utils/hpc/HpcCombine.hs +++ b/utils/hpc/HpcCombine.hs @@ -13,6 +13,7 @@ import HpcFlags import Control.Monad import qualified Data.Set as Set import qualified Data.Map as Map +import qualified Data.IntMap as IM import qualified Data.Text as T ------------------------------------------------------------------------------ @@ -141,7 +142,7 @@ mergeTix modComb f || tixModuleTickCount tm1 /= tixModuleTickCount tm2 -> error $ "mismatched in module " ++ T.unpack m | otherwise -> - mkTixModule' m (tixModuleHash tm1) (tixModuleTickCount tm1) (zipWith f (tixModuleTixs tm1) (tixModuleTixs tm2)) + mkTixModule m (tixModuleHash tm1) (mergeTickCounts f (tixModuleTixs tm1) (tixModuleTixs tm2)) (Just m1,Nothing) -> m1 (Nothing,Just m2) -> @@ -189,9 +190,12 @@ instance Strict Tix where strict (Tix t1) = Tix $! strict t1 +instance Strict TickCounts where + strict i = i + instance Strict TixModule where - strict (TixModule m1 p1 i1 t1) = - ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1) + strict (TixModule m1 p1 t1) = + (((TixModule $! strict m1) $! strict p1)) $! strict t1 instance Strict T.Text where strict i = i diff --git a/utils/hpc/HpcDraft.hs b/utils/hpc/HpcDraft.hs index cdd1728f65..ac866d5043 100644 --- a/utils/hpc/HpcDraft.hs +++ b/utils/hpc/HpcDraft.hs @@ -48,7 +48,7 @@ draft_main hpcflags (progName:mods) = do Just (Tix tickCounts) -> do outs <- sequence [ makeDraft hpcflags1 tixModule - | tixModule@(TixModule m _ _ _) <- tickCounts + | tixModule@(TixModule m _ _) <- tickCounts , allowModule hpcflags1 m ] case outputFile hpcflags1 of @@ -60,7 +60,7 @@ draft_main hpcflags (progName:mods) = do makeDraft :: Flags -> TixModule -> IO String makeDraft hpcflags tix = do let modu = tixModuleName tix - tixs = tixModuleTixs tix + tixs = tickCountsToList $ tixModuleTixs tix (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix) diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index a8c7f25e25..47da5d99c7 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -162,8 +162,8 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix) let arr_tix :: Array Int Integer - arr_tix = listArray (0,length (tixModuleTixs tix) - 1) - $ tixModuleTixs tix + arr_tix = listArray (0,tickCountsSize (tixModuleTixs tix) - 1) + $ tickCountsToList $ tixModuleTixs tix let tickedWith :: Int -> Integer tickedWith n = arr_tix ! n diff --git a/utils/hpc/HpcOverlay.hs b/utils/hpc/HpcOverlay.hs index b303b2cfec..5424c10faf 100644 --- a/utils/hpc/HpcOverlay.hs +++ b/utils/hpc/HpcOverlay.hs @@ -133,7 +133,7 @@ processModule modName modContents (Mix _ _ hash _ entries) locals globals = do | n <- [0..(length entries - 1)] ] - return $ TixModule modName hash (length tixs') tixs' + return $ TixModule modName hash (tickCountsFromList (length entries) tixs') qualifier :: HpcPos -> Maybe Qualifier -> Bool qualifier _ Nothing = True diff --git a/utils/hpc/HpcReport.hs b/utils/hpc/HpcReport.hs index 164e8912af..7cdd0c2e29 100644 --- a/utils/hpc/HpcReport.hs +++ b/utils/hpc/HpcReport.hs @@ -151,16 +151,16 @@ single (LocalBox _) = True single (BinBox {}) = False modInfo :: Flags -> Bool -> TixModule -> IO ModInfo -modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do +modInfo hpcflags qualDecList tix@(TixModule moduleName _ _) = do Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix) - return (q (accumCounts (zip (map snd mes) tickCounts) miZero)) + return (q (accumCounts (zip (map snd mes) (tickCountsToList $ tixModuleTixs tix)) miZero)) where q mi | qualDecList = mi{decPaths = map (T.unpack moduleName:) (decPaths mi)} | otherwise = mi modReport :: Flags -> TixModule -> IO () -modReport hpcflags tix@(TixModule moduleName _ _ _) = do +modReport hpcflags tix@(TixModule moduleName _ _) = do mi <- modInfo hpcflags False tix if xmlOutput hpcflags then putStrLn $ " <module name = " ++ show moduleName ++ ">" @@ -225,7 +225,7 @@ report_main hpcflags (progName:mods) = do makeReport hpcflags1 progName $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2) $ [ tix' - | tix'@(TixModule m _ _ _) <- tickCounts + | tix'@(TixModule m _ _) <- tickCounts , allowModule hpcflags1 m ] Nothing -> hpcError report_plugin $ "unable to find tix file for:" ++ progName diff --git a/utils/hpc/HpcShowTix.hs b/utils/hpc/HpcShowTix.hs index 7931a6d8df..8f3a674bed 100644 --- a/utils/hpc/HpcShowTix.hs +++ b/utils/hpc/HpcShowTix.hs @@ -54,9 +54,9 @@ showtix_main flags (prog:modNames) = do sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++ rjust 10 (show count) ++ " " ++ ljust 20 (T.unpack modName) ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab) - | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries + | (count,ix,(pos,lab)) <- zip3 (tickCountsToList $ tixModuleTixs tm) [(0::Int)..] entries ] - | ( TixModule modName _hash1 _ tixs' + | ( tm@(TixModule modName _hash1 _) , Mix _file _timestamp _hash2 _tab entries ) <- tixs_mixs ] |