{-# 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 = Word64 -> RemotePtr a
forall a. Word64 -> RemotePtr a
RemotePtr (WordPtr -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr a -> WordPtr
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) = WordPtr -> Ptr a
forall a. WordPtr -> Ptr a
wordPtrToPtr (Word64 -> WordPtr
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) = Word64 -> RemotePtr b
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
[RemoteRef a] -> ShowS
RemoteRef a -> String
(Int -> RemoteRef a -> ShowS)
-> (RemoteRef a -> String)
-> ([RemoteRef a] -> ShowS)
-> Show (RemoteRef a)
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
(RemoteRef a -> Put)
-> Get (RemoteRef a)
-> ([RemoteRef a] -> Put)
-> Binary (RemoteRef a)
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 = RemoteRef a -> RemoteRef HValue
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 <- a -> IO (StablePtr a)
forall a. a -> IO (StablePtr a)
newStablePtr a
a
RemoteRef a -> IO (RemoteRef a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RemoteRef a -> IO (RemoteRef a))
-> RemoteRef a -> IO (RemoteRef a)
forall a b. (a -> b) -> a -> b
$! RemotePtr () -> RemoteRef a
forall a. RemotePtr () -> RemoteRef a
RemoteRef (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr (StablePtr a -> Ptr ()
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) =
StablePtr a -> IO a
forall a. StablePtr a -> IO a
deRefStablePtr (Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (RemotePtr () -> Ptr ()
forall a. RemotePtr a -> Ptr a
fromRemotePtr RemotePtr ()
w))
freeRemoteRef :: RemoteRef a -> IO ()
freeRemoteRef :: forall a. RemoteRef a -> IO ()
freeRemoteRef (RemoteRef RemotePtr ()
w) =
StablePtr Any -> IO ()
forall a. StablePtr a -> IO ()
freeStablePtr (Ptr () -> StablePtr Any
forall a. Ptr () -> StablePtr a
castPtrToStablePtr (RemotePtr () -> Ptr ()
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 ForeignRef a -> () -> ()
`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 =
ForeignPtr () -> ForeignRef a
forall a. ForeignPtr () -> ForeignRef a
ForeignRef (ForeignPtr () -> ForeignRef a)
-> IO (ForeignPtr ()) -> IO (ForeignRef a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr () -> IO () -> IO (ForeignPtr ())
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (RemotePtr () -> Ptr ()
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 =
ForeignPtr () -> (Ptr () -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fp (RemoteRef a -> IO b
f (RemoteRef a -> IO b) -> (Ptr () -> RemoteRef a) -> Ptr () -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemotePtr () -> RemoteRef a
forall a. RemotePtr () -> RemoteRef a
RemoteRef (RemotePtr () -> RemoteRef a)
-> (Ptr () -> RemotePtr ()) -> Ptr () -> RemoteRef a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr)
unsafeForeignRefToRemoteRef :: ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef :: forall a. ForeignRef a -> RemoteRef a
unsafeForeignRefToRemoteRef (ForeignRef ForeignPtr ()
fp) =
RemotePtr () -> RemoteRef a
forall a. RemotePtr () -> RemoteRef a
RemoteRef (Ptr () -> RemotePtr ()
forall a. Ptr a -> RemotePtr a
toRemotePtr (ForeignPtr () -> Ptr ()
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr ()
fp))
finalizeForeignRef :: ForeignRef a -> IO ()
finalizeForeignRef :: forall a. ForeignRef a -> IO ()
finalizeForeignRef (ForeignRef ForeignPtr ()
fp) = ForeignPtr () -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr ()
fp