module Basement.FinalPtr
( FinalPtr(..)
, finalPtrSameMemory
, castFinalPtr
, toFinalPtr
, toFinalPtrForeign
, touchFinalPtr
, withFinalPtr
, withUnsafeFinalPtr
, withFinalPtrNoTouch
) where
import GHC.Ptr
import GHC.ForeignPtr
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 (ForeignPtr a)
instance Show (FinalPtr a) where
show f = runST $ withFinalPtr f (pure . show)
instance Eq (FinalPtr a) where
(==) f1 f2 = runST (equal f1 f2)
instance Ord (FinalPtr a) where
compare f1 f2 = runST (compare_ f1 f2)
finalPtrSameMemory :: FinalPtr a -> FinalPtr b -> Bool
finalPtrSameMemory (FinalPtr p1) (FinalPtr p2) = p1 == castPtr p2
finalPtrSameMemory (FinalForeign p1) (FinalForeign p2) = p1 == castForeignPtr p2
finalPtrSameMemory (FinalForeign _) (FinalPtr _) = False
finalPtrSameMemory (FinalPtr _) (FinalForeign _) = False
toFinalPtr :: PrimMonad prim => Ptr a -> (Ptr a -> IO ()) -> prim (FinalPtr a)
toFinalPtr ptr finalizer = unsafePrimFromIO (primitive makeWithFinalizer)
where
makeWithFinalizer s =
case compatMkWeak# ptr () (finalizer ptr) s of { (# s2, _ #) -> (# s2, FinalPtr ptr #) }
toFinalPtrForeign :: ForeignPtr a -> FinalPtr a
toFinalPtrForeign fptr = FinalForeign fptr
castFinalPtr :: FinalPtr a -> FinalPtr b
castFinalPtr (FinalPtr a) = FinalPtr (castPtr a)
castFinalPtr (FinalForeign a) = FinalForeign (castForeignPtr a)
withFinalPtrNoTouch :: FinalPtr p -> (Ptr p -> a) -> a
withFinalPtrNoTouch (FinalPtr ptr) f = f ptr
withFinalPtrNoTouch (FinalForeign fptr) f = f (unsafeForeignPtrToPtr fptr)
withFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr (FinalPtr ptr) f = do
r <- f ptr
primTouch ptr
pure r
withFinalPtr (FinalForeign fptr) f = do
r <- f (unsafeForeignPtrToPtr fptr)
unsafePrimFromIO (touchForeignPtr fptr)
pure r
touchFinalPtr :: PrimMonad prim => FinalPtr p -> prim ()
touchFinalPtr (FinalPtr ptr) = primTouch ptr
touchFinalPtr (FinalForeign fptr) = unsafePrimFromIO (touchForeignPtr fptr)
withUnsafeFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> a
withUnsafeFinalPtr fptr f = unsafePerformIO (unsafePrimToIO (withFinalPtr fptr f))
equal :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Bool
equal f1 f2 =
withFinalPtr f1 $ \ptr1 ->
withFinalPtr f2 $ \ptr2 ->
pure $ ptr1 == ptr2
compare_ :: PrimMonad prim => FinalPtr a -> FinalPtr a -> prim Ordering
compare_ f1 f2 =
withFinalPtr f1 $ \ptr1 ->
withFinalPtr f2 $ \ptr2 ->
pure $ ptr1 `compare` ptr2