diff options
| -rw-r--r-- | compiler/GHC/Runtime/Interpreter.hs | 6 | ||||
| -rw-r--r-- | libraries/ghci/GHCi/RemoteTypes.hs | 65 |
2 files changed, 45 insertions, 26 deletions
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs index 64790ba8a4..c40e9cd1f6 100644 --- a/compiler/GHC/Runtime/Interpreter.hs +++ b/compiler/GHC/Runtime/Interpreter.hs @@ -690,17 +690,15 @@ principle it would probably be ok, but it seems less hairy this way. -- 'RemoteRef' when it is no longer referenced. mkFinalizedHValue :: Interp -> RemoteRef a -> IO (ForeignRef a) mkFinalizedHValue interp rref = do - let hvref = toHValueRef rref - free <- case interpInstance interp of #if defined(HAVE_INTERNAL_INTERPRETER) - InternalInterp -> return (freeRemoteRef hvref) + InternalInterp -> return (freeRemoteRef rref) #endif ExternalInterp _ (IServ i) -> return $ modifyMVar_ i $ \state -> case state of IServPending {} -> pure state -- already shut down IServRunning inst -> do - let !inst' = inst {iservPendingFrees = hvref:iservPendingFrees inst} + let !inst' = inst {iservPendingFrees = castRemoteRef rref : iservPendingFrees inst} pure (IServRunning inst') mkForeignRef rref free diff --git a/libraries/ghci/GHCi/RemoteTypes.hs b/libraries/ghci/GHCi/RemoteTypes.hs index bbd7d32bed..77b663b2c4 100644 --- a/libraries/ghci/GHCi/RemoteTypes.hs +++ b/libraries/ghci/GHCi/RemoteTypes.hs @@ -8,14 +8,29 @@ -- compiler/GHC/Runtime/Interpreter.hs. -- module GHCi.RemoteTypes - ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr + ( -- * Remote pointer + RemotePtr(..) + , toRemotePtr + , fromRemotePtr + , castRemotePtr + -- * RemoteRef: reference to some heap object (potentially remote) + , RemoteRef (..) + , mkRemoteRef + , localRef + , freeRemoteRef + , castRemoteRef + -- * ForeignRef: RemoteRef with a finalizer + , ForeignRef + , mkForeignRef + , withForeignRef + , finalizeForeignRef + , castForeignRef + , unsafeForeignRefToRemoteRef + -- * HValue , HValue(..) - , RemoteRef, mkRemoteRef, localRef, freeRemoteRef - , HValueRef, toHValueRef - , ForeignRef, mkForeignRef, withForeignRef + , HValueRef , ForeignHValue - , unsafeForeignRefToRemoteRef, finalizeForeignRef - ) where +) where import Prelude -- See note [Why do we import Prelude here?] import Control.DeepSeq @@ -23,7 +38,6 @@ import Data.Word import Foreign hiding (newForeignPtr) import Foreign.Concurrent import Data.Binary -import Unsafe.Coerce import GHC.Exts import GHC.ForeignPtr @@ -52,23 +66,28 @@ deriving instance Binary (RemotePtr a) deriving instance NFData (RemotePtr a) -- ----------------------------------------------------------------------------- --- HValueRef +-- HValue: alias for Any newtype HValue = HValue Any instance Show HValue where show _ = "<HValue>" --- | A reference to a remote value. These are allocated and freed explicitly. +-- For convenience +type HValueRef = RemoteRef HValue +type ForeignHValue = ForeignRef HValue + +-- ----------------------------------------------------------------------------- +-- RemoteRef: pointer to a Heap object + +-- | A reference to a heap object. Potentially in a remote heap! +-- These are allocated and freed explicitly. newtype RemoteRef a = RemoteRef (RemotePtr ()) deriving (Show, Binary) -- We can discard type information if we want -toHValueRef :: RemoteRef a -> RemoteRef HValue -toHValueRef = unsafeCoerce - --- For convenience -type HValueRef = RemoteRef HValue +castRemoteRef :: RemoteRef a -> RemoteRef b +castRemoteRef = coerce -- | Make a reference to a local value that we can send remotely. -- This reference will keep the value that it refers to alive until @@ -78,34 +97,33 @@ mkRemoteRef a = do sp <- newStablePtr a return $! RemoteRef (toRemotePtr (castStablePtrToPtr sp)) --- | Convert an HValueRef to an HValue. Should only be used if the HValue --- originated in this process. +-- | Convert a RemoteRef to its carried type. Should only be used if the +-- RemoteRef originated in this process. localRef :: RemoteRef a -> IO a localRef (RemoteRef w) = deRefStablePtr (castPtrToStablePtr (fromRemotePtr w)) --- | Release an HValueRef that originated in this process +-- | Release a RemoteRef that originated in this process freeRemoteRef :: RemoteRef a -> IO () freeRemoteRef (RemoteRef w) = freeStablePtr (castPtrToStablePtr (fromRemotePtr w)) --- | An HValueRef with a finalizer +-- | An RemoteRef with a finalizer newtype ForeignRef a = ForeignRef (ForeignPtr ()) instance NFData (ForeignRef a) where rnf x = x `seq` () -type ForeignHValue = ForeignRef HValue -- | Create a 'ForeignRef' from a 'RemoteRef'. The finalizer --- should arrange to call 'freeHValueRef' on the 'HValueRef'. (since +-- should arrange to call 'freeRemoteRef' on the 'RemoteRef'. (since -- this function needs to be called in the process that created the --- 'HValueRef', it cannot be called directly from the finalizer). +-- 'RemoteRef', it cannot be called directly from the finalizer). mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a) mkForeignRef (RemoteRef hvref) finalizer = ForeignRef <$> newForeignPtr (fromRemotePtr hvref) finalizer --- | Use a 'ForeignHValue' +-- | Use a 'ForeignRef' withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b withForeignRef (ForeignRef fp) f = withForeignPtr fp (f . RemoteRef . toRemotePtr) @@ -116,3 +134,6 @@ unsafeForeignRefToRemoteRef (ForeignRef fp) = finalizeForeignRef :: ForeignRef a -> IO () finalizeForeignRef (ForeignRef fp) = finalizeForeignPtr fp + +castForeignRef :: ForeignRef a -> ForeignRef b +castForeignRef = coerce |