[Git][ghc/ghc][master] GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
eed0d930 by Sylvain Henry at 2023-04-04T11:09:15-04:00
GHCi.RemoteTypes: fix doc and avoid unsafeCoerce (#23201)

- - - - -


2 changed files:

- compiler/GHC/Runtime/Interpreter.hs
- libraries/ghci/GHCi/RemoteTypes.hs


Changes:

=====================================
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


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eed0d9307b3f48b6a2e45dbb246610cf4ab73896

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eed0d9307b3f48b6a2e45dbb246610cf4ab73896
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230404/cbeb8952/attachment-0001.html>