hpc 0.5.0.4 → 0.5.0.5
raw patch · 3 files changed
+81/−81 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Trace/Hpc/Mix.hs +75/−75
- Trace/Hpc/Reflect.hsc +5/−5
- hpc.cabal +1/−1
Trace/Hpc/Mix.hs view
@@ -3,19 +3,19 @@ -- Colin Runciman and Andy Gill, June 2006 --------------------------------------------------------------- --- |Datatypes and file-access routines for the per-module (.mix) +-- |Datatypes and file-access routines for the per-module (.mix) -- indexes used by Hpc. module Trace.Hpc.Mix- ( Mix(..)- , MixEntry- , BoxLabel(..)- , CondBox(..)- , mixCreate- , readMix- , Trace.Hpc.Mix.getModificationTime- , createMixEntryDom- , MixEntryDom- )+ ( Mix(..)+ , MixEntry+ , BoxLabel(..)+ , CondBox(..)+ , mixCreate+ , readMix+ , Trace.Hpc.Mix.getModificationTime+ , createMixEntryDom+ , MixEntryDom+ ) where import System.Time (ClockTime(..))@@ -29,21 +29,21 @@ -- in the list import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..))-import Trace.Hpc.Tix +import Trace.Hpc.Tix --- | 'Mix' is the information about a modules static properties, like +-- | 'Mix' is the information about a modules static properties, like -- location of Tix's in a file. -- tab stops are the size of a tab in the provided line:colunm values. -- * In GHC, this is 1 (a tab is just a character) -- * With hpc-tracer, this is 8 (a tab represents several spaces). -data Mix = Mix - FilePath -- location of original file- Integer -- time (in seconds) of original file's last update, since 1970.- Hash -- hash of mix entry + timestamp- Int -- tab stop value.- [MixEntry] -- entries- deriving (Show,Read)+data Mix = Mix+ FilePath -- location of original file+ Integer -- time (in seconds) of original file's last update, since 1970.+ Hash -- hash of mix entry + timestamp+ Int -- tab stop value.+ [MixEntry] -- entries+ deriving (Show,Read) -- We would rather use ClockTime in Mix, but ClockTime has no Read instance in 6.4 and before, -- but does in 6.6. Definining the instance for ClockTime here is the Wrong Thing to do,@@ -51,10 +51,10 @@ type MixEntry = (HpcPos, BoxLabel) -data BoxLabel = ExpBox Bool -- isAlt +data BoxLabel = ExpBox Bool -- isAlt | TopLevelBox [String] | LocalBox [String]- | BinBox CondBox Bool+ | BinBox CondBox Bool deriving (Read, Show, Eq, Ord) data CondBox = GuardBinBox@@ -66,45 +66,45 @@ toHash (ExpBox b) = 0x100 + toHash b toHash (TopLevelBox nm) = 0x200 + toHash nm toHash (LocalBox nm) = 0x300 + toHash nm- toHash (BinBox cond b) = 0x400 + toHash (cond,b) + toHash (BinBox cond b) = 0x400 + toHash (cond,b) instance HpcHash CondBox where- toHash GuardBinBox = 0x10 - toHash CondBinBox = 0x20 + toHash GuardBinBox = 0x10+ toHash CondBinBox = 0x20 toHash QualBinBox = 0x30 - + -- | Create is mix file. mixCreate :: String -- ^ Dir Name- -> String -- ^ module Name- -> Mix -- ^ Mix DataStructure- -> IO ()+ -> String -- ^ module Name+ -> Mix -- ^ Mix DataStructure+ -> IO () mixCreate dirName modName mix = writeFile (mixName dirName modName) (show mix) -- | Read a mix file.-readMix :: [String] -- ^ Dir Names- -> Either String TixModule -- ^ module wanted- -> IO Mix+readMix :: [String] -- ^ Dir Names+ -> Either String TixModule -- ^ module wanted+ -> IO Mix readMix dirNames mod' = do let modName = case mod' of- Left str -> str- Right tix -> tixModuleName tix+ Left str -> str+ Right tix -> tixModuleName tix res <- sequence [ (do contents <- readFile (mixName dirName modName)- case reads contents of- [(r@(Mix _ _ h _ _),cs)] - | all isSpace cs - && (case mod' of- Left _ -> True- Right tix -> h == tixModuleHash tix- ) -> return $ Just r- _ -> return $ Nothing) `catch` (\ _ -> return $ Nothing) - | dirName <- dirNames- ] + case reads contents of+ [(r@(Mix _ _ h _ _),cs)]+ | all isSpace cs+ && (case mod' of+ Left _ -> True+ Right tix -> h == tixModuleHash tix+ ) -> return $ Just r+ _ -> return $ Nothing) `catch` (\ _ -> return $ Nothing)+ | dirName <- dirNames+ ] case catMaybes res of [r] -> return r xs@(_:_) -> error $ "found " ++ show(length xs) ++ " instances of " ++ modName ++ " in " ++ show dirNames- _ -> error $ "can not find " ++ modName ++ " in " ++ show dirNames + _ -> error $ "can not find " ++ modName ++ " in " ++ show dirNames mixName :: FilePath -> String -> String mixName dirName name = dirName ++ "/" ++ name ++ ".mix"@@ -125,9 +125,9 @@ -- There is no ordering to the children isGoodNode :: MixEntryDom a -> Bool-isGoodNode (Node (pos,_) sub_nodes) = - and [ pos' `insideHpcPos` pos | Node(pos',_) _ <- sub_nodes ] - && and [ pos' /= pos | Node(pos',_) _ <- sub_nodes ] +isGoodNode (Node (pos,_) sub_nodes) =+ and [ pos' `insideHpcPos` pos | Node(pos',_) _ <- sub_nodes ]+ && and [ pos' /= pos | Node(pos',_) _ <- sub_nodes ] && isGoodForest sub_nodes -- all sub-trees are good trees, and no two HpcPos are inside each other.@@ -135,57 +135,57 @@ isGoodForest sub_nodes = all isGoodNode sub_nodes && and [ not (pos1 `insideHpcPos` pos2 ||- pos2 `insideHpcPos` pos1)- | (Node (pos1,_) _,n1) <- zip sub_nodes [0..]- , (Node (pos2,_) _,n2) <- zip sub_nodes [0..]- , (n1 :: Int) /= n2 ]+ pos2 `insideHpcPos` pos1)+ | (Node (pos1,_) _,n1) <- zip sub_nodes [0..]+ , (Node (pos2,_) _,n2) <- zip sub_nodes [0..]+ , (n1 :: Int) /= n2 ] addNodeToTree :: (Show a) => (HpcPos,a) -> MixEntryDom [a] -> MixEntryDom [a]-addNodeToTree (new_pos,new_a) (Node (pos,a) children) +addNodeToTree (new_pos,new_a) (Node (pos,a) children) | pos == new_pos = Node (pos,new_a : a) children- | new_pos `insideHpcPos` pos = + | new_pos `insideHpcPos` pos = Node (pos,a) (addNodeToList (new_pos,new_a) children) | pos `insideHpcPos` new_pos = error "precondition not met inside addNodeToNode" | otherwise = error "something impossible happened in addNodeToTree" addNodeToList :: Show a => (HpcPos,a) -> [MixEntryDom [a]] -> [MixEntryDom [a]]-addNodeToList (new_pos,new_a) entries +addNodeToList (new_pos,new_a) entries | otherwise =- if length [ () + if length [ () | (am_inside,am_outside,_) <- entries'- , am_inside || am_outside - ] == 0+ , am_inside || am_outside+ ] == 0 -- The case where we have a new HpcPos range then Node (new_pos,[new_a]) [] : entries else- if length [ () - | (am_inside,_,_) <- entries' - , am_inside- ] > 0+ if length [ ()+ | (am_inside,_,_) <- entries'+ , am_inside+ ] > 0 -- The case where we are recursing into a tree -- Note we can recurse down many branches, in the case of -- overlapping ranges.- -- Assumes we have captures the new HpcPos + -- Assumes we have captures the new HpcPos -- (or the above conditional would be true)- then [ if i_am_inside -- or the same as - then addNodeToTree (new_pos,new_a) node- else node- | (i_am_inside,_,node) <- entries'- ] else+ then [ if i_am_inside -- or the same as+ then addNodeToTree (new_pos,new_a) node+ else node+ | (i_am_inside,_,node) <- entries'+ ] else -- The case of a super-range.- ( Node (new_pos,[new_a]) - [ node | (_,True,node) <- entries' ] :+ ( Node (new_pos,[new_a])+ [ node | (_,True,node) <- entries' ] : [ node | (_,False,node) <- entries' ] ) where entries' = [ ( new_pos `insideHpcPos` pos- , pos `insideHpcPos` new_pos- , node)- | node@(Node (pos,_) _) <- entries- ]+ , pos `insideHpcPos` new_pos+ , node)+ | node@(Node (pos,_) _) <- entries+ ] createMixEntryDom :: (Show a) => [(HpcPos,a)] -> [MixEntryDom [a]]-createMixEntryDom entries +createMixEntryDom entries | isGoodForest forest = forest | otherwise = error "createMixEntryDom: bad forest" where forest = foldr addNodeToList [] entries
Trace/Hpc/Reflect.hsc view
@@ -40,7 +40,7 @@ ptr <- hs_hpc_rootModule moduleInfoList ptr -data ModuleInfo = ModuleInfo String Int Hash (Ptr Word64) +data ModuleInfo = ModuleInfo String Word32 Hash (Ptr Word64) moduleInfoList :: Ptr () -> IO [ModuleInfo] moduleInfoList ptr@@ -57,7 +57,7 @@ clearTix :: IO () clearTix = do- sequence_ [ pokeArray ptr $ take count $ repeat 0+ sequence_ [ pokeArray ptr $ take (fromIntegral count) $ repeat 0 | ModuleInfo _mod count _hash ptr <- modInfo ] return ()@@ -65,8 +65,8 @@ examineTix :: IO Tix examineTix = do- mods <- sequence [ do tixs <- peekArray count ptr- return $ TixModule mod' hash count+ mods <- sequence [ do tixs <- peekArray (fromIntegral count) ptr+ return $ TixModule mod' hash (fromIntegral count) $ map fromIntegral tixs | (ModuleInfo mod' count hash ptr) <- modInfo ]@@ -82,7 +82,7 @@ | (ModuleInfo mod1 count1 hash1 ptr, TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes , if mod1 /= mod2 - || count1 /= count2 + || (fromIntegral count1) /= count2 || hash1 /= hash2 || length tixs /= count2 then error "updateTix failed"
hpc.cabal view
@@ -1,5 +1,5 @@ name: hpc-version: 0.5.0.4+version: 0.5.0.5 license: BSD3 license-file: LICENSE author: Andy Gill