{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}
module Foundation.Primitive.FinalPtr
( FinalPtr(..)
, finalPtrSameMemory
, castFinalPtr
, toFinalPtr
, toFinalPtrForeign
, withFinalPtr
, withUnsafeFinalPtr
, withFinalPtrNoTouch
) where
import GHC.Ptr
import GHC.ForeignPtr
import GHC.IO
import Foundation.Primitive.Monad
import Foundation.Internal.Primitive
import Foundation.Internal.Base
data FinalPtr a = FinalPtr (Ptr a)
| FinalForeign (ForeignPtr a)
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)
{-# INLINE withFinalPtrNoTouch #-}
withFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr (FinalPtr ptr) f = do
r <- f ptr
primTouch ptr
return r
withFinalPtr (FinalForeign fptr) f = do
r <- f (unsafeForeignPtrToPtr fptr)
unsafePrimFromIO (touchForeignPtr fptr)
return r
{-# INLINE withFinalPtr #-}
withUnsafeFinalPtr :: PrimMonad prim => FinalPtr p -> (Ptr p -> prim a) -> a
withUnsafeFinalPtr fptr f = unsafePerformIO (unsafePrimToIO (withFinalPtr fptr f))
{-# NOINLINE withUnsafeFinalPtr #-}