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 = unsafePerformIO $ do
ptr <- hs_hpc_rootModule
moduleInfoList ptr
data ModuleInfo = ModuleInfo String Word32 Hash (Ptr Word64)
moduleInfoList :: Ptr () -> IO [ModuleInfo]
moduleInfoList ptr
| ptr == nullPtr = return []
| otherwise = do
cModName <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
modName <- peekCString cModName
tickCount <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
hashNo <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
tixArr <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
next <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
rest <- moduleInfoList next
return $ ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : rest
clearTix :: IO ()
clearTix = do
sequence_ [ pokeArray ptr $ take (fromIntegral count) $ repeat 0
| ModuleInfo _mod count _hash ptr <- modInfo
]
return ()
examineTix :: IO Tix
examineTix = do
mods <- sequence [ do tixs <- peekArray (fromIntegral count) ptr
return $ TixModule mod' hash (fromIntegral count)
$ map fromIntegral tixs
| (ModuleInfo mod' count hash ptr) <- modInfo
]
return $ Tix mods
updateTix :: Tix -> IO ()
updateTix (Tix modTixes)
| length modTixes /= length modInfo = error "updateTix failed"
| otherwise = do
sequence_ [ pokeArray ptr $ map fromIntegral tixs
| (ModuleInfo mod1 count1 hash1 ptr,
TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes
, if mod1 /= mod2
|| (fromIntegral count1) /= count2
|| hash1 /= hash2
|| length tixs /= count2
then error "updateTix failed"
else True
]
return ()