summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2023-03-31 12:47:21 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2023-04-04 11:09:15 -0400
commiteed0d9307b3f48b6a2e45dbb246610cf4ab73896 (patch)
tree38751ee9aedb8c18f5bd852334a0f65f91604399
parentcd00e321d5d7aaee3999b283a2a2f0d77f7b3e8e (diff)
downloadhaskell-eed0d9307b3f48b6a2e45dbb246610cf4ab73896.tar.gz
GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201)
-rw-r--r--compiler/GHC/Runtime/Interpreter.hs6
-rw-r--r--libraries/ghci/GHCi/RemoteTypes.hs65
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