{-# INCLUDE "Rts.h" #-}
{-# LINE 1 "Trace/Hpc/Reflect.hsc" #-}
{-# OPTIONS -fglasgow-exts -cpp #-}
{-# LINE 2 "Trace/Hpc/Reflect.hsc" #-}
module Trace.Hpc.Reflect 
  ( clearTix
  , examineTix
  , updateTix 
  ) where

import Foreign.C.String
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable ( Storable(..) )
import Data.Word 
import Data.Int
import Trace.Hpc.Tix
import Trace.Hpc.Util
import System.IO.Unsafe


{-# LINE 19 "Trace/Hpc/Reflect.hsc" #-}

foreign import ccall unsafe hs_hpc_rootModule :: IO (Ptr ())

modInfo :: [ModuleInfo]
modInfo = unsafePerformIO $ do
      ptr <- hs_hpc_rootModule 
      moduleInfoList ptr

data ModuleInfo = ModuleInfo String Int Hash (Ptr Word64) 

moduleInfoList :: Ptr () -> IO [ModuleInfo]
moduleInfoList ptr
  | ptr == nullPtr = return []
  | otherwise = do
        cModName  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 34 "Trace/Hpc/Reflect.hsc" #-}
        modName   <- peekCString cModName
        tickCount <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 36 "Trace/Hpc/Reflect.hsc" #-}
        hashNo    <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 37 "Trace/Hpc/Reflect.hsc" #-}
        tixArr    <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 38 "Trace/Hpc/Reflect.hsc" #-}
	next      <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 39 "Trace/Hpc/Reflect.hsc" #-}
        rest      <- moduleInfoList next
        return $ ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : rest

clearTix :: IO ()
clearTix = do
      sequence_ [ pokeArray ptr $ take count $ repeat 0
      	      	| ModuleInfo _mod count _hash ptr <- modInfo
		]
      return ()


examineTix :: IO Tix
examineTix = do
      mods <- sequence [ do tixs <- peekArray count ptr
      	      	       	    return $ TixModule mod' hash count
			    	   $ map fromIntegral tixs
      	      	       | (ModuleInfo mod' count hash ptr) <- modInfo
		       ]
      return $ Tix mods

-- requirement that the tix be of the same shape as the 
-- internal tix.
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 
		|| count1 /= count2 
		|| hash1 /= hash2
		|| length tixs /= count2
		  then error "updateTix failed"
		  else True
		]
      return ()