{-# 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 = IO [ModuleInfo] -> [ModuleInfo]
forall a. IO a -> a
unsafePerformIO (IO [ModuleInfo] -> [ModuleInfo])
-> IO [ModuleInfo] -> [ModuleInfo]
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 Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr = [ModuleInfo] -> IO [ModuleInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise = do
        CString
cModName  <- ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
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 -> Ptr () -> Int -> IO Word32
forall b. Ptr b -> Int -> IO Word32
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 -> Ptr () -> Int -> IO Int
forall b. Ptr b -> Int -> IO Int
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 -> Ptr () -> Int -> IO (Ptr Word64)
forall b. Ptr b -> Int -> IO (Ptr Word64)
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 -> Ptr () -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (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
        [ModuleInfo] -> IO [ModuleInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ModuleInfo] -> IO [ModuleInfo])
-> [ModuleInfo] -> IO [ModuleInfo]
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> Hash -> Ptr Word64 -> ModuleInfo
ModuleInfo String
modName Word32
tickCount (Int -> Hash
forall a. HpcHash a => a -> Hash
toHash (Int
hashNo :: Int)) Ptr Word64
tixArr ModuleInfo -> [ModuleInfo] -> [ModuleInfo]
forall a. a -> [a] -> [a]
: [ModuleInfo]
rest

clearTix :: IO ()
clearTix :: IO ()
clearTix = do
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr ([Word64] -> IO ()) -> [Word64] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Word64] -> [Word64]
forall a. Int -> [a] -> [a]
take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count) ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Word64 -> [Word64]
forall a. a -> [a]
repeat Word64
0
                | ModuleInfo String
_mod Word32
count Hash
_hash Ptr Word64
ptr <- [ModuleInfo]
modInfo
                ]
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


examineTix :: IO Tix
examineTix :: IO Tix
examineTix = do
      [TixModule]
mods <- [IO TixModule] -> IO [TixModule]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [ do [Word64]
tixs <- Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count) Ptr Word64
ptr
                            TixModule -> IO TixModule
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TixModule -> IO TixModule) -> TixModule -> IO TixModule
forall a b. (a -> b) -> a -> b
$ String -> Hash -> Int -> [Integer] -> TixModule
TixModule String
mod' Hash
hash (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count)
                                   ([Integer] -> TixModule) -> [Integer] -> TixModule
forall a b. (a -> b) -> a -> b
$ (Word64 -> Integer) -> [Word64] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word64]
tixs
                       | (ModuleInfo String
mod' Word32
count Hash
hash Ptr Word64
ptr) <- [ModuleInfo]
modInfo
                       ]
      Tix -> IO Tix
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tix -> IO Tix) -> Tix -> IO Tix
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)
  | [TixModule] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TixModule]
modTixes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [ModuleInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModuleInfo]
modInfo = String -> IO ()
forall a. HasCallStack => String -> a
error String
"updateTix failed"
  | Bool
otherwise = do
      [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Ptr Word64 -> [Word64] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word64
ptr ([Word64] -> IO ()) -> [Word64] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Integer -> Word64) -> [Integer] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Word64
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) <- [ModuleInfo] -> [TixModule] -> [(ModuleInfo, TixModule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ModuleInfo]
modInfo [TixModule]
modTixes
                , if String
mod1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
mod2
                Bool -> Bool -> Bool
|| (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
count1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
count2
                Bool -> Bool -> Bool
|| Hash
hash1 Hash -> Hash -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash
hash2
                Bool -> Bool -> Bool
|| [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Integer]
tixs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
count2
                  then String -> Bool
forall a. HasCallStack => String -> a
error String
"updateTix failed"
                  else Bool
True
                ]
      () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()