{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Foreign.Prim.WeakPtr
( Weak(..)
, mkWeak
, mkWeakNoFinalizer
, mkWeakPtr
, mkWeakPtrNoFinalizer
, addFinalizer
, addCFinalizer
, addCFinalizerEnv
, deRefWeak
, finalizeWeak
) where
import Control.Monad
import Control.Prim.Monad
import GHC.Weak (Weak(..))
import Foreign.Prim
mkWeak :: MonadUnliftPrim RW m => a -> v -> m b -> m (Weak v)
mkWeak key val finalizer =
runInPrimBase finalizer $ \f s ->
case mkWeak# key val f s of
(# s', w #) -> (# s', Weak w #)
mkWeakNoFinalizer :: MonadPrim RW m => a -> v -> m (Weak v)
mkWeakNoFinalizer key val =
prim $ \s ->
case mkWeakNoFinalizer# key val s of
(# s', w #) -> (# s', Weak w #)
mkWeakPtr :: MonadUnliftPrim RW m => k -> m b -> m (Weak k)
mkWeakPtr key = mkWeak key key
mkWeakPtrNoFinalizer :: MonadPrim RW m => k -> m (Weak k)
mkWeakPtrNoFinalizer key = mkWeakNoFinalizer key key
addFinalizer :: MonadUnliftPrim RW m => k -> m b -> m ()
addFinalizer key = void . mkWeakPtr key
addCFinalizer ::
MonadPrim RW m
=> FunPtr (Ptr a -> IO ())
-> Ptr a
-> Weak v
-> m Bool
addCFinalizer (FunPtr faddr#) (Ptr addr#) (Weak weak#) =
prim $ \s ->
case addCFinalizerToWeak# faddr# addr# 0# nullAddr# weak# s of
(# s', i# #) -> (# s', isTrue# i# #)
addCFinalizerEnv ::
MonadPrim RW m
=> FunPtr (Ptr env -> Ptr a -> IO ())
-> Ptr env
-> Ptr a
-> Weak v
-> m Bool
addCFinalizerEnv (FunPtr faddr#) (Ptr envAddr#) (Ptr addr#) (Weak weak#) =
prim $ \s ->
case addCFinalizerToWeak# faddr# addr# 1# envAddr# weak# s of
(# s', i# #) -> (# s', isTrue# i# #)
deRefWeak :: MonadPrim RW m => Weak v -> m (Maybe v)
deRefWeak (Weak weak#) =
prim $ \s ->
case deRefWeak# weak# s of
(# s', 0#, _ #) -> (# s', Nothing #)
(# s', _, a #) -> (# s', Just a #)
finalizeWeak :: MonadPrim RW m => Weak v -> m ()
finalizeWeak (Weak w) =
prim $ \s ->
case finalizeWeak# w s of
(# s1, 0#, _ #) -> (# s1, () #)
(# s1, _, f #) -> f s1