{-# 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

-- requirement that the tix be of the same shape as the
-- internal tix.
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 ()