{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module GHC.StaticPtr
( StaticPtr
, deRefStaticPtr
, StaticKey
, staticKey
, unsafeLookupStaticPtr
, StaticPtrInfo(..)
, staticPtrInfo
, staticPtrKeys
, IsStatic(..)
) where
import Foreign.C.Types (CInt(..))
import Foreign.Marshal (allocaArray, peekArray)
import GHC.Ptr (Ptr(..), nullPtr)
import GHC.Fingerprint (Fingerprint(..))
import GHC.Prim
import GHC.Word (Word64(..))
#include "MachDeps.h"
#if WORD_SIZE_IN_BITS < 64
data StaticPtr a = StaticPtr Word64# Word64#
StaticPtrInfo a
#else
data StaticPtr a = StaticPtr Word# Word#
StaticPtrInfo a
#endif
deRefStaticPtr :: StaticPtr a -> a
deRefStaticPtr :: StaticPtr a -> a
deRefStaticPtr (StaticPtr _ _ _ v :: a
v) = a
v
type StaticKey = Fingerprint
staticKey :: StaticPtr a -> StaticKey
staticKey :: StaticPtr a -> StaticKey
staticKey (StaticPtr w0 :: Word#
w0 w1 :: Word#
w1 _ _) = Word64 -> Word64 -> StaticKey
Fingerprint (Word# -> Word64
W64# Word#
w0) (Word# -> Word64
W64# Word#
w1)
unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a))
unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a))
unsafeLookupStaticPtr (Fingerprint w1 :: Word64
w1 w2 :: Word64
w2) = do
ptr :: Ptr Any
ptr@(Ptr addr :: Addr#
addr) <- Word64 -> Word64 -> IO (Ptr Any)
forall a. Word64 -> Word64 -> IO (Ptr a)
hs_spt_lookup Word64
w1 Word64
w2
if (Ptr Any
ptr Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
forall a. Ptr a
nullPtr)
then Maybe (StaticPtr a) -> IO (Maybe (StaticPtr a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (StaticPtr a)
forall a. Maybe a
Nothing
else case Addr# -> (# StaticPtr a #)
forall a. Addr# -> (# a #)
addrToAny# Addr#
addr of
(# spe :: StaticPtr a
spe #) -> Maybe (StaticPtr a) -> IO (Maybe (StaticPtr a))
forall (m :: * -> *) a. Monad m => a -> m a
return (StaticPtr a -> Maybe (StaticPtr a)
forall a. a -> Maybe a
Just StaticPtr a
spe)
foreign import ccall unsafe hs_spt_lookup :: Word64 -> Word64 -> IO (Ptr a)
class IsStatic p where
fromStaticPtr :: StaticPtr a -> p a
instance IsStatic StaticPtr where
fromStaticPtr :: StaticPtr a -> StaticPtr a
fromStaticPtr = StaticPtr a -> StaticPtr a
forall a. a -> a
id
data StaticPtrInfo = StaticPtrInfo
{
StaticPtrInfo -> String
spInfoUnitId :: String
, StaticPtrInfo -> String
spInfoModuleName :: String
, StaticPtrInfo -> (Int, Int)
spInfoSrcLoc :: (Int, Int)
}
deriving Show
staticPtrInfo :: StaticPtr a -> StaticPtrInfo
staticPtrInfo :: StaticPtr a -> StaticPtrInfo
staticPtrInfo (StaticPtr _ _ n :: StaticPtrInfo
n _) = StaticPtrInfo
n
staticPtrKeys :: IO [StaticKey]
staticPtrKeys :: IO [StaticKey]
staticPtrKeys = do
CInt
keyCount <- IO CInt
hs_spt_key_count
Int -> (Ptr (Ptr Word64) -> IO [StaticKey]) -> IO [StaticKey]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
keyCount) ((Ptr (Ptr Word64) -> IO [StaticKey]) -> IO [StaticKey])
-> (Ptr (Ptr Word64) -> IO [StaticKey]) -> IO [StaticKey]
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (Ptr Word64)
p -> do
CInt
count <- Ptr (Ptr Word64) -> CInt -> IO CInt
forall a. Ptr a -> CInt -> IO CInt
hs_spt_keys Ptr (Ptr Word64)
p CInt
keyCount
Int -> Ptr (Ptr Word64) -> IO [Ptr Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
count) Ptr (Ptr Word64)
p IO [Ptr Word64]
-> ([Ptr Word64] -> IO [StaticKey]) -> IO [StaticKey]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Ptr Word64 -> IO StaticKey) -> [Ptr Word64] -> IO [StaticKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\pa :: Ptr Word64
pa -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray 2 Ptr Word64
pa IO [Word64] -> ([Word64] -> IO StaticKey) -> IO StaticKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[w1 :: Word64
w1, w2 :: Word64
w2] -> StaticKey -> IO StaticKey
forall (m :: * -> *) a. Monad m => a -> m a
return (StaticKey -> IO StaticKey) -> StaticKey -> IO StaticKey
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> StaticKey
Fingerprint Word64
w1 Word64
w2)
{-# NOINLINE staticPtrKeys #-}
foreign import ccall unsafe hs_spt_key_count :: IO CInt
foreign import ccall unsafe hs_spt_keys :: Ptr a -> CInt -> IO CInt