{-# LINE 1 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 3 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
{-# LANGUAGE Trustworthy #-}
{-# LINE 5 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
module Trace.Hpc.Reflect
( clearTix
, examineTix
, updateTix
) where
import Trace.Hpc.Tix
import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable ( Storable(..) )
import Data.Word
import Trace.Hpc.Util
import System.IO.Unsafe
foreign import ccall unsafe hs_hpc_rootModule :: IO (Ptr ())
modInfo :: [ModuleInfo]
modInfo :: [ModuleInfo]
modInfo = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
Ptr ()
ptr <- IO (Ptr ())
hs_hpc_rootModule
Ptr () -> IO [ModuleInfo]
moduleInfoList Ptr ()
ptr
data ModuleInfo = ModuleInfo String Word32 Hash (Ptr Word64)
moduleInfoList :: Ptr () -> IO [ModuleInfo]
moduleInfoList :: Ptr () -> IO [ModuleInfo]
moduleInfoList Ptr ()
ptr
| Ptr ()
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise = do
CString
cModName <- ((\Ptr ()
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
0)) Ptr ()
ptr
{-# LINE 38 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
String
modName <- CString -> IO String
peekCString CString
cModName
Word32
tickCount <- ((\Ptr ()
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
8)) Ptr ()
ptr
{-# LINE 40 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
Int
hashNo <- ((\Ptr ()
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
12)) Ptr ()
ptr
{-# LINE 41 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
Ptr Word64
tixArr <- ((\Ptr ()
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
16)) Ptr ()
ptr
{-# LINE 42 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
Ptr ()
next <- ((\Ptr ()
hsc_ptr -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
32)) Ptr ()
ptr
{-# LINE 43 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
[ModuleInfo]
rest <- Ptr () -> IO [ModuleInfo]
moduleInfoList Ptr ()
next
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Word32 -> Hash -> Ptr Word64 -> ModuleInfo
ModuleInfo String
modName Word32
tickCount (forall a. HpcHash a => a -> Hash
toHash (Int
hashNo :: Int)) Ptr Word64
tixArr forall a. a -> [a] -> [a]
: [ModuleInfo]
rest
clearTix :: IO ()
clearTix :: IO ()
clearTix = do
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count) forall a b. (a -> b) -> a -> b
$ forall a. a -> [a]
repeat Word64
0
| ModuleInfo String
_mod Word32
count Hash
_hash Ptr Word64
ptr <- [ModuleInfo]
modInfo
]
forall (m :: * -> *) a. Monad m => a -> m a
return ()
examineTix :: IO Tix
examineTix :: IO Tix
examineTix = do
[TixModule]
mods <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ do [Word64]
tixs <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count) Ptr Word64
ptr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Hash -> Int -> [Integer] -> TixModule
TixModule String
mod' Hash
hash (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word64]
tixs
| (ModuleInfo String
mod' Word32
count Hash
hash Ptr Word64
ptr) <- [ModuleInfo]
modInfo
]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [TixModule] -> Tix
Tix [TixModule]
mods
updateTix :: Tix -> IO ()
updateTix :: Tix -> IO ()
updateTix (Tix [TixModule]
modTixes)
| forall (t :: * -> *) a. Foldable t => t a -> Int
length [TixModule]
modTixes forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleInfo]
modInfo = forall a. HasCallStack => String -> a
error String
"updateTix failed"
| Bool
otherwise = do
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
tixs
| (ModuleInfo String
mod1 Word32
count1 Hash
hash1 Ptr Word64
ptr,
TixModule String
mod2 Hash
hash2 Int
count2 [Integer]
tixs) <- forall a b. [a] -> [b] -> [(a, b)]
zip [ModuleInfo]
modInfo [TixModule]
modTixes
, if String
mod1 forall a. Eq a => a -> a -> Bool
/= String
mod2
Bool -> Bool -> Bool
|| (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count1) forall a. Eq a => a -> a -> Bool
/= Int
count2
Bool -> Bool -> Bool
|| Hash
hash1 forall a. Eq a => a -> a -> Bool
/= Hash
hash2
Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
tixs forall a. Eq a => a -> a -> Bool
/= Int
count2
then forall a. HasCallStack => String -> a
error String
"updateTix failed"
else Bool
True
]
forall (m :: * -> *) a. Monad m => a -> m a
return ()