{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}
module Basement.FinalPtr
( FinalPtr(..)
, finalPtrSameMemory
, castFinalPtr
, toFinalPtr
, toFinalPtrForeign
, touchFinalPtr
, withFinalPtr
, withUnsafeFinalPtr
, withFinalPtrNoTouch
) where
import GHC.Ptr
import qualified GHC.ForeignPtr as GHCF
import GHC.IO
import Basement.Monad
import Basement.Compat.Primitive
import Basement.Compat.Base
import Control.Monad.ST (runST)
data FinalPtr a = FinalPtr (Ptr a)
| FinalForeign (GHCF.ForeignPtr a)
instance Show (FinalPtr a) where
show :: FinalPtr a -> String
show FinalPtr a
f = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr a
f (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show)
instance Eq (FinalPtr a) where
== :: FinalPtr a -> FinalPtr a -> Bool
(==) FinalPtr a
f1 FinalPtr a
f2 = forall a. (forall s. ST s a) -> a
runST (forall (prim :: * -> *) a.
PrimMonad prim =>
FinalPtr a -> FinalPtr a -> prim Bool
equal FinalPtr a
f1 FinalPtr a
f2)
instance Ord (FinalPtr a) where
compare :: FinalPtr a -> FinalPtr a -> Ordering
compare FinalPtr a
f1 FinalPtr a
f2 = forall a. (forall s. ST s a) -> a
runST (forall (prim :: * -> *) a.
PrimMonad prim =>
FinalPtr a -> FinalPtr a -> prim Ordering
compare_ FinalPtr a
f1 FinalPtr a
f2)
finalPtrSameMemory :: FinalPtr a -> FinalPtr b -> Bool
finalPtrSameMemory :: forall a b. FinalPtr a -> FinalPtr b -> Bool
finalPtrSameMemory (FinalPtr Ptr a
p1) (FinalPtr Ptr b
p2) = Ptr a
p1 forall a. Eq a => a -> a -> Bool
== forall a b. Ptr a -> Ptr b
castPtr Ptr b
p2
finalPtrSameMemory (FinalForeign ForeignPtr a
p1) (FinalForeign ForeignPtr b
p2) = ForeignPtr a
p1 forall a. Eq a => a -> a -> Bool
== forall a b. ForeignPtr a -> ForeignPtr b
GHCF.castForeignPtr ForeignPtr b
p2
finalPtrSameMemory (FinalForeign ForeignPtr a
_) (FinalPtr Ptr b
_) = Bool
False
finalPtrSameMemory (FinalPtr Ptr a
_) (FinalForeign ForeignPtr b
_) = Bool
False
toFinalPtr :: PrimMonad prim => Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)
toFinalPtr :: forall (prim :: * -> *) a.
PrimMonad prim =>
Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)
toFinalPtr Ptr a
ptr Ptr a -> IO ()
finalizer = forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
unsafePrimFromIO (forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive State# RealWorld -> (# State# RealWorld, FinalPtr a #)
makeWithFinalizer)
where
makeWithFinalizer :: State# RealWorld -> (# State# RealWorld, FinalPtr a #)
makeWithFinalizer State# RealWorld
s =
case forall o b.
o
-> b
-> IO ()
-> State# RealWorld
-> (# State# RealWorld, Weak# b #)
compatMkWeak# Ptr a
ptr () (Ptr a -> IO ()
finalizer Ptr a
ptr) State# RealWorld
s of { (# State# RealWorld
s2, Weak# ()
_ #) -> (# State# RealWorld
s2, forall a. Ptr a -> FinalPtr a
FinalPtr Ptr a
ptr #) }
toFinalPtrForeign :: GHCF.ForeignPtr a -> FinalPtr a
toFinalPtrForeign :: forall a. ForeignPtr a -> FinalPtr a
toFinalPtrForeign ForeignPtr a
fptr = forall a. ForeignPtr a -> FinalPtr a
FinalForeign ForeignPtr a
fptr
castFinalPtr :: FinalPtr a -> FinalPtr b
castFinalPtr :: forall a b. FinalPtr a -> FinalPtr b
castFinalPtr (FinalPtr Ptr a
a) = forall a. Ptr a -> FinalPtr a
FinalPtr (forall a b. Ptr a -> Ptr b
castPtr Ptr a
a)
castFinalPtr (FinalForeign ForeignPtr a
a) = forall a. ForeignPtr a -> FinalPtr a
FinalForeign (forall a b. ForeignPtr a -> ForeignPtr b
GHCF.castForeignPtr ForeignPtr a
a)
withFinalPtrNoTouch :: FinalPtr p -> (Ptr p -> a) -> a
withFinalPtrNoTouch :: forall p a. FinalPtr p -> (Ptr p -> a) -> a
withFinalPtrNoTouch (FinalPtr Ptr p
ptr) Ptr p -> a
f = Ptr p -> a
f Ptr p
ptr
withFinalPtrNoTouch (FinalForeign ForeignPtr p
fptr) Ptr p -> a
f = Ptr p -> a
f (forall a. ForeignPtr a -> Ptr a
GHCF.unsafeForeignPtrToPtr ForeignPtr p
fptr)
{-# INLINE withFinalPtrNoTouch #-}
withFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr :: forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr (FinalPtr Ptr p
ptr) Ptr p -> prim a
f = do
a
r <- Ptr p -> prim a
f Ptr p
ptr
forall (m :: * -> *) a. PrimMonad m => a -> m ()
primTouch Ptr p
ptr
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
withFinalPtr (FinalForeign ForeignPtr p
fptr) Ptr p -> prim a
f = do
a
r <- Ptr p -> prim a
f (forall a. ForeignPtr a -> Ptr a
GHCF.unsafeForeignPtrToPtr ForeignPtr p
fptr)
forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
unsafePrimFromIO (forall a. ForeignPtr a -> IO ()
GHCF.touchForeignPtr ForeignPtr p
fptr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
{-# INLINE withFinalPtr #-}
touchFinalPtr :: PrimMonad prim => FinalPtr p -> prim ()
touchFinalPtr :: forall (prim :: * -> *) p. PrimMonad prim => FinalPtr p -> prim ()
touchFinalPtr (FinalPtr Ptr p
ptr) = forall (m :: * -> *) a. PrimMonad m => a -> m ()
primTouch Ptr p
ptr
touchFinalPtr (FinalForeign ForeignPtr p
fptr) = forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
unsafePrimFromIO (forall a. ForeignPtr a -> IO ()
GHCF.touchForeignPtr ForeignPtr p
fptr)
withUnsafeFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> a
withUnsafeFinalPtr :: forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> a
withUnsafeFinalPtr FinalPtr p
fptr Ptr p -> prim a
f = forall a. IO a -> a
unsafePerformIO (forall (prim :: * -> *) a. PrimMonad prim => prim a -> IO a
unsafePrimToIO (forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr p
fptr Ptr p -> prim a
f))
{-# NOINLINE withUnsafeFinalPtr #-}
equal :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Bool
equal :: forall (prim :: * -> *) a.
PrimMonad prim =>
FinalPtr a -> FinalPtr a -> prim Bool
equal FinalPtr a
f1 FinalPtr a
f2 =
forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr a
f1 forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr1 ->
forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr a
f2 forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr2 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr a
ptr1 forall a. Eq a => a -> a -> Bool
== Ptr a
ptr2
{-# INLINE equal #-}
compare_ :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Ordering
compare_ :: forall (prim :: * -> *) a.
PrimMonad prim =>
FinalPtr a -> FinalPtr a -> prim Ordering
compare_ FinalPtr a
f1 FinalPtr a
f2 =
forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr a
f1 forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr1 ->
forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr a
f2 forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr2 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr a
ptr1 forall a. Ord a => a -> a -> Ordering
`compare` Ptr a
ptr2
{-# INLINE compare_ #-}