{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Internal.StaticPtr
( StaticPtr
, deRefStaticPtr
, StaticKey
, staticKey
, unsafeLookupStaticPtr
, StaticPtrInfo(..)
, staticPtrInfo
, staticPtrKeys
, IsStatic(..)
) where
import GHC.Internal.Data.Typeable (Typeable)
import GHC.Internal.Foreign.C.Types (CInt(..))
import GHC.Internal.Foreign.Marshal.Array (allocaArray, peekArray, withArray)
import GHC.Internal.Base
import GHC.Internal.Ptr (Ptr(..), nullPtr)
import GHC.Internal.Fingerprint (Fingerprint(..))
import GHC.Internal.Real
import GHC.Internal.Word (Word64(..))
import GHC.Internal.Text.Show
data StaticPtr a = StaticPtr Word64# Word64#
StaticPtrInfo a
deRefStaticPtr :: StaticPtr a -> a
deRefStaticPtr :: forall a. StaticPtr a -> a
deRefStaticPtr (StaticPtr Word64#
_ Word64#
_ StaticPtrInfo
_ a
v) = a
v
type StaticKey = Fingerprint
staticKey :: StaticPtr a -> StaticKey
staticKey :: forall a. StaticPtr a -> StaticKey
staticKey (StaticPtr Word64#
w0 Word64#
w1 StaticPtrInfo
_ a
_) = Word64 -> Word64 -> StaticKey
Fingerprint (Word64# -> Word64
W64# Word64#
w0) (Word64# -> Word64
W64# Word64#
w1)
unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a))
unsafeLookupStaticPtr :: forall a. StaticKey -> IO (Maybe (StaticPtr a))
unsafeLookupStaticPtr (Fingerprint Word64
w1 Word64
w2) = do
ptr@(Ptr addr) <- [Word64]
-> (Ptr Word64 -> IO (Ptr (ZonkAny 0))) -> IO (Ptr (ZonkAny 0))
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Word64
w1, Word64
w2] Ptr Word64 -> IO (Ptr (ZonkAny 0))
forall a. Ptr Word64 -> IO (Ptr a)
hs_spt_lookup
if (ptr == nullPtr)
then return Nothing
else case addrToAny# addr of
(# StaticPtr a
spe #) -> Maybe (StaticPtr a) -> IO (Maybe (StaticPtr a))
forall a. a -> IO 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 :: Ptr Word64 -> IO (Ptr a)
class IsStatic p where
fromStaticPtr :: Typeable a => StaticPtr a -> p a
instance IsStatic StaticPtr where
fromStaticPtr :: forall a. Typeable a => 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 Int -> StaticPtrInfo -> ShowS
[StaticPtrInfo] -> ShowS
StaticPtrInfo -> String
(Int -> StaticPtrInfo -> ShowS)
-> (StaticPtrInfo -> String)
-> ([StaticPtrInfo] -> ShowS)
-> Show StaticPtrInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StaticPtrInfo -> ShowS
showsPrec :: Int -> StaticPtrInfo -> ShowS
$cshow :: StaticPtrInfo -> String
show :: StaticPtrInfo -> String
$cshowList :: [StaticPtrInfo] -> ShowS
showList :: [StaticPtrInfo] -> ShowS
Show
staticPtrInfo :: StaticPtr a -> StaticPtrInfo
staticPtrInfo :: forall a. StaticPtr a -> StaticPtrInfo
staticPtrInfo (StaticPtr Word64#
_ Word64#
_ StaticPtrInfo
n a
_) = StaticPtrInfo
n
staticPtrKeys :: IO [StaticKey]
staticPtrKeys :: IO [StaticKey]
staticPtrKeys = do
keyCount <- IO CInt
hs_spt_key_count
allocaArray (fromIntegral keyCount) $ \Ptr (Ptr Word64)
p -> do
count <- Ptr (Ptr Word64) -> CInt -> IO CInt
forall a. Ptr a -> CInt -> IO CInt
hs_spt_keys Ptr (Ptr Word64)
p CInt
keyCount
peekArray (fromIntegral count) p >>=
mapM (\Ptr Word64
pa -> Int -> Ptr Word64 -> IO [Word64]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr Word64
pa IO [Word64] -> ([Word64] -> IO StaticKey) -> IO StaticKey
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Word64
w1, Word64
w2] -> StaticKey -> IO StaticKey
forall a. a -> IO a
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