{-# LINE 1 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
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 <- IO (Ptr ())
hs_hpc_rootModule
      moduleInfoList 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
        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 34 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
        modName   <- peekCString cModName
        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
{-# LINE 36 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
        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
{-# LINE 37 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
        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
{-# LINE 38 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
        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
{-# LINE 39 "libraries/hpc/Trace/Hpc/Reflect.hsc" #-}
        rest      <- moduleInfoList next
        return $ ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : 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
      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 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
                            return $ TixModule mod' hash (fromIntegral count)
                                   $ map fromIntegral tixs
                       | (ModuleInfo String
mod' Word32
count Hash
hash Ptr Word64
ptr) <- [ModuleInfo]
modInfo
                       ]
      return $ Tix 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 ()