{-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}

-- |
-- Types for referring to remote objects in Remote GHCi.  For more
-- details, see Note [External GHCi pointers] in compiler/ghci/GHCi.hs
--
-- For details on Remote GHCi, see Note [Remote GHCi] in
-- compiler/ghci/GHCi.hs.
--
module GHCi.RemoteTypes
  ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr
  , HValue(..)
  , RemoteRef, mkRemoteRef, localRef, freeRemoteRef
  , HValueRef, toHValueRef
  , ForeignRef, mkForeignRef, withForeignRef
  , ForeignHValue
  , unsafeForeignRefToRemoteRef, finalizeForeignRef
  ) where

import Prelude -- See note [Why do we import Prelude here?]
import Control.DeepSeq
import Data.Word
import Foreign hiding (newForeignPtr)
import Foreign.Concurrent
import Data.Binary
import Unsafe.Coerce
import GHC.Exts
import GHC.ForeignPtr

-- -----------------------------------------------------------------------------
-- RemotePtr

-- Static pointers only; don't use this for heap-resident pointers.
-- Instead use HValueRef. We will fix the remote pointer to be 64 bits. This
-- should cover 64 and 32bit systems, and permits the exchange of remote ptrs
-- between machines of different word size. For exmaple, when connecting to
-- an iserv instance on a different architecture with different word size via
-- -fexternal-interpreter.
newtype RemotePtr a = RemotePtr Word64

toRemotePtr :: Ptr a -> RemotePtr a
toRemotePtr :: Ptr a -> RemotePtr a
toRemotePtr p :: Ptr a
p = Word64 -> RemotePtr a
forall a. Word64 -> RemotePtr a
RemotePtr (WordPtr -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr a -> WordPtr
forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr a
p))

fromRemotePtr :: RemotePtr a -> Ptr a
fromRemotePtr :: RemotePtr a -> Ptr a
fromRemotePtr (RemotePtr p :: Word64
p) = WordPtr -> Ptr a
forall a. WordPtr -> Ptr a
wordPtrToPtr (Word64 -> WordPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
p)

castRemotePtr :: RemotePtr a -> RemotePtr b
castRemotePtr :: RemotePtr a -> RemotePtr b
castRemotePtr (RemotePtr a :: Word64
a) = Word64 -> RemotePtr b
forall a. Word64 -> RemotePtr a
RemotePtr Word64
a

deriving instance Show (RemotePtr a)
deriving instance Binary (RemotePtr a)
deriving instance NFData (RemotePtr a)

-- -----------------------------------------------------------------------------
-- HValueRef

newtype HValue = HValue Any

instance Show HValue where
  show :: HValue -> String
show _ = "<HValue>"

-- | A reference to a remote value.  These are allocated and freed explicitly.
newtype RemoteRef a = RemoteRef (RemotePtr ())
  deriving (Int -> RemoteRef a -> ShowS
[RemoteRef a] -> ShowS
RemoteRef a -> String
(Int -> RemoteRef a -> ShowS)
-> (RemoteRef a -> String)
-> ([RemoteRef a] -> ShowS)
-> Show (RemoteRef a)
forall a. Int -> RemoteRef a -> ShowS
forall a. [RemoteRef a] -> ShowS
forall a. RemoteRef a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteRef a] -> ShowS
$cshowList :: forall a. [RemoteRef a] -> ShowS
show :: RemoteRef a -> String
$cshow :: forall a. RemoteRef a -> String
showsPrec :: Int -> RemoteRef a -> ShowS
$cshowsPrec :: forall a. Int -> RemoteRef a -> ShowS
Show, Get (RemoteRef a)
[RemoteRef a] -> Put
RemoteRef a -> Put
(RemoteRef a -> Put)
-> Get (RemoteRef a)
-> ([RemoteRef a] -> Put)
-> Binary (RemoteRef a)
forall a. Get (RemoteRef a)
forall a. [RemoteRef a] -> Put
forall a. RemoteRef a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [RemoteRef a] -> Put
$cputList :: forall a. [RemoteRef a] -> Put
get :: Get (RemoteRef a)
$cget :: forall a. Get (RemoteRef a)
put :: RemoteRef a -> Put
$cput :: forall a. RemoteRef a -> Put
Binary)

-- We can discard type information if we want
toHValueRef :: RemoteRef a -> RemoteRef HValue
toHValueRef :: RemoteRef a -> RemoteRef HValue
toHValueRef = RemoteRef a -> RemoteRef HValue
forall a b. a -> b
unsafeCoerce

-- For convenience
type HValueRef = RemoteRef HValue

-- | Make a reference to a local value that we can send remotely.
-- This reference will keep the value that it refers to alive until
-- 'freeRemoteRef' is called.
mkRemoteRef :: a -> IO (RemoteRef a)
mkRemoteRef :: a -> IO (RemoteRef a)
mkRemoteRef a :: a
a = do
  StablePtr a
sp <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
a
  RemoteRef a -> IO (RemoteRef a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRef a -> IO (RemoteRef a))
-> RemoteRef a -> IO (RemoteRef a)
forall a b. (a -> b) -> a -> b
$! RemotePtr () -> RemoteRef a
forall a. RemotePtr () -> RemoteRef a
RemoteRef (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr (StablePtr a -> Ptr ()
forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
sp))

-- | Convert an HValueRef to an HValue.  Should only be used if the HValue
-- originated in this process.
localRef :: RemoteRef a -> IO a
localRef :: RemoteRef a -> IO a
localRef (RemoteRef w :: RemotePtr ()
w) =
  StablePtr a -> IO a
forall a. StablePtr a -> IO a
deRefStablePtr (Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
w))

-- | Release an HValueRef that originated in this process
freeRemoteRef :: RemoteRef a -> IO ()
freeRemoteRef :: RemoteRef a -> IO ()
freeRemoteRef (RemoteRef w :: RemotePtr ()
w) =
  StablePtr Any -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr (Ptr () -> StablePtr Any
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
w))

-- | An HValueRef with a finalizer
newtype ForeignRef a = ForeignRef (ForeignPtr ())

instance NFData (ForeignRef a) where
  rnf :: ForeignRef a -> ()
rnf x :: ForeignRef a
x = ForeignRef a
x ForeignRef a -> () -> ()
forall a b. a -> b -> b
`seq` ()

type ForeignHValue = ForeignRef HValue

-- | Create a 'ForeignRef' from a 'RemoteRef'.  The finalizer
-- should arrange to call 'freeHValueRef' on the 'HValueRef'.  (since
-- this function needs to be called in the process that created the
-- 'HValueRef', it cannot be called directly from the finalizer).
mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)
mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)
mkForeignRef (RemoteRef hvref :: RemotePtr ()
hvref) finalizer :: IO ()
finalizer =
  ForeignPtr () -> ForeignRef a
forall a. ForeignPtr () -> ForeignRef a
ForeignRef (ForeignPtr () -> ForeignRef a)
-> IO (ForeignPtr ()) -> IO (ForeignRef a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr () -> IO () -> IO (ForeignPtr ())
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
hvref) IO ()
finalizer

-- | Use a 'ForeignHValue'
withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef (ForeignRef fp :: ForeignPtr ()
fp) f :: RemoteRef a -> IO b
f =
   ForeignPtr () -> (Ptr () -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fp (RemoteRef a -> IO b
f (RemoteRef a -> IO b) -> (Ptr () -> RemoteRef a) -> Ptr () -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemotePtr () -> RemoteRef a
forall a. RemotePtr () -> RemoteRef a
RemoteRef (RemotePtr () -> RemoteRef a)
-> (Ptr () -> RemotePtr ()) -> Ptr () -> RemoteRef a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr)

unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef (ForeignRef fp :: ForeignPtr ()
fp) =
  RemotePtr () -> RemoteRef a
forall a. RemotePtr () -> RemoteRef a
RemoteRef (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr (ForeignPtr () -> Ptr ()
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr ()
fp))

finalizeForeignRef :: ForeignRef a -> IO ()
finalizeForeignRef :: ForeignRef a -> IO ()
finalizeForeignRef (ForeignRef fp :: ForeignPtr ()
fp) = ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fp