never executed always true always false

    1 {-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
    2 
    3 -- |
    4 -- Types for referring to remote objects in Remote GHCi.  For more
    5 -- details, see Note [External GHCi pointers] in compiler/GHC/Runtime/Interpreter.hs
    6 --
    7 -- For details on Remote GHCi, see Note [Remote GHCi] in
    8 -- compiler/GHC/Runtime/Interpreter.hs.
    9 --
   10 module GHCi.RemoteTypes
   11   ( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr
   12   , HValue(..)
   13   , RemoteRef, mkRemoteRef, localRef, freeRemoteRef
   14   , HValueRef, toHValueRef
   15   , ForeignRef, mkForeignRef, withForeignRef
   16   , ForeignHValue
   17   , unsafeForeignRefToRemoteRef, finalizeForeignRef
   18   ) where
   19 
   20 import Prelude -- See note [Why do we import Prelude here?]
   21 import Control.DeepSeq
   22 import Data.Word
   23 import Foreign hiding (newForeignPtr)
   24 import Foreign.Concurrent
   25 import Data.Binary
   26 import Unsafe.Coerce
   27 import GHC.Exts
   28 import GHC.ForeignPtr
   29 
   30 -- -----------------------------------------------------------------------------
   31 -- RemotePtr
   32 
   33 -- Static pointers only; don't use this for heap-resident pointers.
   34 -- Instead use HValueRef. We will fix the remote pointer to be 64 bits. This
   35 -- should cover 64 and 32bit systems, and permits the exchange of remote ptrs
   36 -- between machines of different word size. For example, when connecting to
   37 -- an iserv instance on a different architecture with different word size via
   38 -- -fexternal-interpreter.
   39 newtype RemotePtr a = RemotePtr Word64
   40 
   41 toRemotePtr :: Ptr a -> RemotePtr a
   42 toRemotePtr p = RemotePtr (fromIntegral (ptrToWordPtr p))
   43 
   44 fromRemotePtr :: RemotePtr a -> Ptr a
   45 fromRemotePtr (RemotePtr p) = wordPtrToPtr (fromIntegral p)
   46 
   47 castRemotePtr :: RemotePtr a -> RemotePtr b
   48 castRemotePtr (RemotePtr a) = RemotePtr a
   49 
   50 deriving instance Show (RemotePtr a)
   51 deriving instance Binary (RemotePtr a)
   52 deriving instance NFData (RemotePtr a)
   53 
   54 -- -----------------------------------------------------------------------------
   55 -- HValueRef
   56 
   57 newtype HValue = HValue Any
   58 
   59 instance Show HValue where
   60   show _ = "<HValue>"
   61 
   62 -- | A reference to a remote value.  These are allocated and freed explicitly.
   63 newtype RemoteRef a = RemoteRef (RemotePtr ())
   64   deriving (Show, Binary)
   65 
   66 -- We can discard type information if we want
   67 toHValueRef :: RemoteRef a -> RemoteRef HValue
   68 toHValueRef = unsafeCoerce
   69 
   70 -- For convenience
   71 type HValueRef = RemoteRef HValue
   72 
   73 -- | Make a reference to a local value that we can send remotely.
   74 -- This reference will keep the value that it refers to alive until
   75 -- 'freeRemoteRef' is called.
   76 mkRemoteRef :: a -> IO (RemoteRef a)
   77 mkRemoteRef a = do
   78   sp <- newStablePtr a
   79   return $! RemoteRef (toRemotePtr (castStablePtrToPtr sp))
   80 
   81 -- | Convert an HValueRef to an HValue.  Should only be used if the HValue
   82 -- originated in this process.
   83 localRef :: RemoteRef a -> IO a
   84 localRef (RemoteRef w) =
   85   deRefStablePtr (castPtrToStablePtr (fromRemotePtr w))
   86 
   87 -- | Release an HValueRef that originated in this process
   88 freeRemoteRef :: RemoteRef a -> IO ()
   89 freeRemoteRef (RemoteRef w) =
   90   freeStablePtr (castPtrToStablePtr (fromRemotePtr w))
   91 
   92 -- | An HValueRef with a finalizer
   93 newtype ForeignRef a = ForeignRef (ForeignPtr ())
   94 
   95 instance NFData (ForeignRef a) where
   96   rnf x = x `seq` ()
   97 
   98 type ForeignHValue = ForeignRef HValue
   99 
  100 -- | Create a 'ForeignRef' from a 'RemoteRef'.  The finalizer
  101 -- should arrange to call 'freeHValueRef' on the 'HValueRef'.  (since
  102 -- this function needs to be called in the process that created the
  103 -- 'HValueRef', it cannot be called directly from the finalizer).
  104 mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)
  105 mkForeignRef (RemoteRef hvref) finalizer =
  106   ForeignRef <$> newForeignPtr (fromRemotePtr hvref) finalizer
  107 
  108 -- | Use a 'ForeignHValue'
  109 withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b
  110 withForeignRef (ForeignRef fp) f =
  111    withForeignPtr fp (f . RemoteRef . toRemotePtr)
  112 
  113 unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
  114 unsafeForeignRefToRemoteRef (ForeignRef fp) =
  115   RemoteRef (toRemotePtr (unsafeForeignPtrToPtr fp))
  116 
  117 finalizeForeignRef :: ForeignRef a -> IO ()
  118 finalizeForeignRef (ForeignRef fp) = finalizeForeignPtr fp