    {-# LANGUAGE ExistentialQuantification #-}
    {-# LANGUAGE MagicHash                 #-}
    {-# LANGUAGE UnboxedTuples             #-}
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.StaticPtr
    -- Copyright   :  (C) 2014 I/O Tweag
    -- License     :  see libraries/base/LICENSE
    --
    -- Maintainer  :  cvs-ghc@haskell.org
    -- Stability   :  internal
    -- Portability :  non-portable (GHC Extensions)
    --
    -- Symbolic references to values.
    --
    -- References to values are usually implemented with memory addresses, and this
    -- is practical when communicating values between the different pieces of a
    -- single process.
    --
    -- When values are communicated across different processes running in possibly
    -- different machines, though, addresses are no longer useful since each
    -- process may use different addresses to store a given value.
    --
    -- To solve such concern, the references provided by this module offer a key
    -- that can be used to locate the values on each process. Each process maintains
    -- a global table of references which can be looked up with a given key. This
    -- table is known as the Static Pointer Table. The reference can then be
    -- dereferenced to obtain the value.
    --
    -- The various communicating processes need to agree on the keys used to refer
    -- to the values in the Static Pointer Table, or lookups will fail. Only
    -- processes launched from the same program binary are guaranteed to use the
    -- same set of keys.
    --
    -----------------------------------------------------------------------------

    module GHC.StaticPtr
      ( StaticPtr
      , deRefStaticPtr
      , StaticKey
      , staticKey
      , unsafeLookupStaticPtr
      , StaticPtrInfo(..)
      , staticPtrInfo
      , staticPtrKeys
      , IsStatic(..)
      ) where

    import Data.Typeable       (Typeable)
    import Foreign.C.Types     (CInt(..))
    import Foreign.Marshal     (allocaArray, peekArray, withArray)
    import GHC.Ptr             (Ptr(..), nullPtr)
    import GHC.Fingerprint     (Fingerprint(..))
    import GHC.Prim
    import GHC.Word            (Word64(..))

    -- | A reference to a value of type @a@.
    data StaticPtr a = StaticPtr Word64# Word64# -- The flattened Fingerprint is
                                                 -- convenient in the compiler.
                                 StaticPtrInfo a

    -- | Dereferences a static pointer.
    deRefStaticPtr :: StaticPtr a -> a
    deRefStaticPtr :: forall a. StaticPtr a -> a
    deRefStaticPtr (StaticPtr Word64#
    _ Word64#
    _ StaticPtrInfo
    _ a
    v) = a
    v

    -- | A key for 'StaticPtr's that can be serialized and used with
    -- 'unsafeLookupStaticPtr'.
    type StaticKey = Fingerprint

    -- | The 'StaticKey' that can be used to look up the given 'StaticPtr'.
    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)

    -- | Looks up a 'StaticPtr' by its 'StaticKey'.
    --
    -- If the 'StaticPtr' is not found returns @Nothing@.
    --
    -- This function is unsafe because the program behavior is undefined if the type
    -- of the returned 'StaticPtr' does not match the expected one.
    --
    unsafeLookupStaticPtr :: StaticKey -> IO (Maybe (StaticPtr a))
    unsafeLookupStaticPtr :: forall a. StaticKey -> IO (Maybe (StaticPtr a))
    unsafeLookupStaticPtr (Fingerprint Word64
    w1 Word64
    w2) = do
        ptr :: Ptr Any
    ptr@(Ptr Addr#
    addr) <- [Word64] -> (Ptr Word64 -> IO (Ptr Any)) -> IO (Ptr Any)
    forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
    withArray [Word64
    w1, Word64
    w2] Ptr Word64 -> IO (Ptr Any)
    forall a. Ptr Word64 -> IO (Ptr a)
    hs_spt_lookup
        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 a. a -> IO 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
               (# 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)

    -- | A class for things buildable from static pointers.
    --
    -- GHC wraps each use of the 'static' keyword with
    -- 'fromStaticPtr'. Because the 'static' keyword requires its argument
    -- to be an instance of 'Typeable', 'fromStaticPtr' carries a
    -- 'Typeable' constraint as well.
    class IsStatic p where
        fromStaticPtr :: Typeable a => StaticPtr a -> p a

    -- | @since 4.9.0.0
    instance IsStatic StaticPtr where
        fromStaticPtr :: forall a. Typeable a => StaticPtr a -> StaticPtr a
    fromStaticPtr = StaticPtr a -> StaticPtr a
    forall a. a -> a
    id

    -- | Miscellaneous information available for debugging purposes.
    data StaticPtrInfo = StaticPtrInfo
        { -- | Package key of the package where the static pointer is defined
          StaticPtrInfo -> String
    spInfoUnitId  :: String
          -- | Name of the module where the static pointer is defined
        , StaticPtrInfo -> String
    spInfoModuleName :: String
          -- | Source location of the definition of the static pointer as a
          -- @(Line, Column)@ pair.
        , 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 -- ^ @since 4.8.0.0

    -- | 'StaticPtrInfo' of the given 'StaticPtr'.
    staticPtrInfo :: StaticPtr a -> StaticPtrInfo
    staticPtrInfo :: forall a. StaticPtr a -> StaticPtrInfo
    staticPtrInfo (StaticPtr Word64#
    _ Word64#
    _ StaticPtrInfo
    n a
    _) = StaticPtrInfo
    n

    -- | A list of all known keys.
    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
    $ \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 a b. IO a -> (a -> IO b) -> IO b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    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