{-# LANGUAGE CPP, StandaloneDeriving, GeneralizedNewtypeDeriving #-}
module GHCi.RemoteTypes
( RemotePtr(..), toRemotePtr, fromRemotePtr, castRemotePtr
, HValue(..)
, RemoteRef, mkRemoteRef, localRef, freeRemoteRef
, HValueRef, toHValueRef
, ForeignRef, mkForeignRef, withForeignRef
, ForeignHValue
, unsafeForeignRefToRemoteRef, finalizeForeignRef
) where
import Prelude
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
newtype RemotePtr a = RemotePtr Word64
toRemotePtr :: Ptr a -> RemotePtr a
toRemotePtr :: forall a. Ptr a -> RemotePtr a
toRemotePtr Ptr a
p = forall a. Word64 -> RemotePtr a
RemotePtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Ptr a -> WordPtr
ptrToWordPtr Ptr a
p))
fromRemotePtr :: RemotePtr a -> Ptr a
fromRemotePtr :: forall a. RemotePtr a -> Ptr a
fromRemotePtr (RemotePtr Word64
p) = forall a. WordPtr -> Ptr a
wordPtrToPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
p)
castRemotePtr :: RemotePtr a -> RemotePtr b
castRemotePtr :: forall a b. RemotePtr a -> RemotePtr b
castRemotePtr (RemotePtr Word64
a) = forall a. Word64 -> RemotePtr a
RemotePtr Word64
a
deriving instance Show (RemotePtr a)
deriving instance Binary (RemotePtr a)
deriving instance NFData (RemotePtr a)
newtype HValue = HValue Any
instance Show HValue where
show :: HValue -> String
show HValue
_ = String
"<HValue>"
newtype RemoteRef a = RemoteRef (RemotePtr ())
deriving (Int -> RemoteRef a -> ShowS
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
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)
toHValueRef :: RemoteRef a -> RemoteRef HValue
toHValueRef :: forall a. RemoteRef a -> RemoteRef HValue
toHValueRef = forall a b. a -> b
unsafeCoerce
type HValueRef = RemoteRef HValue
mkRemoteRef :: a -> IO (RemoteRef a)
mkRemoteRef :: forall a. a -> IO (RemoteRef a)
mkRemoteRef a
a = do
StablePtr a
sp <- forall a. a -> IO (StablePtr a)
newStablePtr a
a
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. RemotePtr () -> RemoteRef a
RemoteRef (forall a. Ptr a -> RemotePtr a
toRemotePtr (forall a. StablePtr a -> Ptr ()
castStablePtrToPtr StablePtr a
sp))
localRef :: RemoteRef a -> IO a
localRef :: forall a. RemoteRef a -> IO a
localRef (RemoteRef RemotePtr ()
w) =
forall a. StablePtr a -> IO a
deRefStablePtr (forall a. Ptr () -> StablePtr a
castPtrToStablePtr (forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
w))
freeRemoteRef :: RemoteRef a -> IO ()
freeRemoteRef :: forall a. RemoteRef a -> IO ()
freeRemoteRef (RemoteRef RemotePtr ()
w) =
forall a. StablePtr a -> IO ()
freeStablePtr (forall a. Ptr () -> StablePtr a
castPtrToStablePtr (forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
w))
newtype ForeignRef a = ForeignRef (ForeignPtr ())
instance NFData (ForeignRef a) where
rnf :: ForeignRef a -> ()
rnf ForeignRef a
x = ForeignRef a
x seq :: forall a b. a -> b -> b
`seq` ()
type ForeignHValue = ForeignRef HValue
mkForeignRef :: RemoteRef a -> IO () -> IO (ForeignRef a)
mkForeignRef :: forall a. RemoteRef a -> IO () -> IO (ForeignRef a)
mkForeignRef (RemoteRef RemotePtr ()
hvref) IO ()
finalizer =
forall a. ForeignPtr () -> ForeignRef a
ForeignRef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
hvref) IO ()
finalizer
withForeignRef :: ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef :: forall a b. ForeignRef a -> (RemoteRef a -> IO b) -> IO b
withForeignRef (ForeignRef ForeignPtr ()
fp) RemoteRef a -> IO b
f =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fp (RemoteRef a -> IO b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RemotePtr () -> RemoteRef a
RemoteRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ptr a -> RemotePtr a
toRemotePtr)
unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef :: forall a. ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef (ForeignRef ForeignPtr ()
fp) =
forall a. RemotePtr () -> RemoteRef a
RemoteRef (forall a. Ptr a -> RemotePtr a
toRemotePtr (forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr ()
fp))
finalizeForeignRef :: ForeignRef a -> IO ()
finalizeForeignRef :: forall a. ForeignRef a -> IO ()
finalizeForeignRef (ForeignRef ForeignPtr ()
fp) = forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fp