+addForeignPtrFinalizer (FunPtr fp) (ForeignPtr p c) = case c of
+ PlainForeignPtr r -> f r >> return ()
+ MallocPtr _ r -> f r >> return ()
+ _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
+ where
+ f r =
+ noMixing CFinalizers r $
+ IO $ \s ->
+ case r of { IORef (STRef r#) ->
+ case mkWeakForeignEnv# r# () fp p 0# nullAddr# s of { (# s1, w #) ->
+ (# s1, finalizeForeign w #) }}
+
+addForeignPtrFinalizerEnv ::
+ FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
+-- ^ Like 'addForeignPtrFinalizerEnv' but allows the finalizer to be
+-- passed an additional environment parameter to be passed to the
+-- finalizer. The environment passed to the finalizer is fixed by the
+-- second argument to 'addForeignPtrFinalizerEnv'
+addForeignPtrFinalizerEnv (FunPtr fp) (Ptr ep) (ForeignPtr p c) = case c of
+ PlainForeignPtr r -> f r >> return ()
+ MallocPtr _ r -> f r >> return ()
+ _ -> error "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer"
+ where
+ f r =
+ noMixing CFinalizers r $
+ IO $ \s ->
+ case r of { IORef (STRef r#) ->
+ case mkWeakForeignEnv# r# () fp p 1# ep s of { (# s1, w #) ->
+ (# s1, finalizeForeign w #) }}
+
+finalizeForeign :: Weak# () -> IO ()
+finalizeForeign w = IO $ \s ->
+ case finalizeWeak# w s of
+ (# s1, 0#, _ #) -> (# s1, () #)
+ (# s1, _ , f #) -> f s1