(original) (raw)

{-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-}

{-# OPTIONS_HADDOCK not-home #-}

module GHC.ForeignPtr (

    [ForeignPtr](GHC.ForeignPtr.html#ForeignPtr)(..),
    [ForeignPtrContents](GHC.ForeignPtr.html#ForeignPtrContents)(..),
    [Finalizers](GHC.ForeignPtr.html#Finalizers)(..),
    [FinalizerPtr](GHC.ForeignPtr.html#FinalizerPtr),
    [FinalizerEnvPtr](GHC.ForeignPtr.html#FinalizerEnvPtr),
    
    [newForeignPtr_](GHC.ForeignPtr.html#newForeignPtr%5F),
    [mallocForeignPtr](GHC.ForeignPtr.html#mallocForeignPtr),
    [mallocPlainForeignPtr](GHC.ForeignPtr.html#mallocPlainForeignPtr),
    [mallocForeignPtrBytes](GHC.ForeignPtr.html#mallocForeignPtrBytes),
    [mallocPlainForeignPtrBytes](GHC.ForeignPtr.html#mallocPlainForeignPtrBytes),
    [mallocForeignPtrAlignedBytes](GHC.ForeignPtr.html#mallocForeignPtrAlignedBytes),
    [mallocPlainForeignPtrAlignedBytes](GHC.ForeignPtr.html#mallocPlainForeignPtrAlignedBytes),
    [newConcForeignPtr](GHC.ForeignPtr.html#newConcForeignPtr),
    
    [addForeignPtrFinalizer](GHC.ForeignPtr.html#addForeignPtrFinalizer),
    [addForeignPtrFinalizerEnv](GHC.ForeignPtr.html#addForeignPtrFinalizerEnv),
    [addForeignPtrConcFinalizer](GHC.ForeignPtr.html#addForeignPtrConcFinalizer),
    
    [unsafeForeignPtrToPtr](GHC.ForeignPtr.html#unsafeForeignPtrToPtr),
    [castForeignPtr](GHC.ForeignPtr.html#castForeignPtr),
    [plusForeignPtr](GHC.ForeignPtr.html#plusForeignPtr),
    
    [withForeignPtr](GHC.ForeignPtr.html#withForeignPtr),
    [unsafeWithForeignPtr](GHC.ForeignPtr.html#unsafeWithForeignPtr),
    [touchForeignPtr](GHC.ForeignPtr.html#touchForeignPtr),
    
    [finalizeForeignPtr](GHC.ForeignPtr.html#finalizeForeignPtr)
    
    

) where

import Foreign.Storable import Data.Foldable ( sequence_ )

import GHC.Show import GHC.Base import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) )

import Unsafe.Coerce ( unsafeCoerce )

data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents

data Finalizers = NoFinalizers

| CFinalizers (Weak# ())

| HaskellFinalizers [IO ()]

data ForeignPtrContents = PlainForeignPtr !(IORef Finalizers)

| FinalPtr

| MallocPtr (MutableByteArray# RealWorld) !(IORef Finalizers)

| PlainPtr (MutableByteArray# RealWorld)

instance Eq (ForeignPtr a) where ForeignPtr a p == :: ForeignPtr a -> ForeignPtr a -> Bool == ForeignPtr a q = ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a p Ptr a -> Ptr a -> Bool forall a. Eq a => a -> a -> Bool == ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a q

instance Ord (ForeignPtr a) where compare :: ForeignPtr a -> ForeignPtr a -> Ordering compare ForeignPtr a p ForeignPtr a q = Ptr a -> Ptr a -> Ordering forall a. Ord a => a -> a -> Ordering compare (ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a p) (ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a q)

instance Show (ForeignPtr a) where showsPrec :: Int -> ForeignPtr a -> ShowS showsPrec Int p ForeignPtr a f = Int -> Ptr a -> ShowS forall a. Show a => Int -> a -> ShowS showsPrec Int p (ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a f)

type FinalizerPtr a = FunPtr (Ptr a -> IO ()) type FinalizerEnvPtr env a = FunPtr (Ptr env -> Ptr a -> IO ())

newConcForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)

newConcForeignPtr :: forall a. Ptr a -> IO () -> IO (ForeignPtr a) newConcForeignPtr Ptr a p IO () finalizer = do ForeignPtr a fObj <- Ptr a -> IO (ForeignPtr a) forall a. Ptr a -> IO (ForeignPtr a) newForeignPtr_ Ptr a p ForeignPtr a -> IO () -> IO () forall a. ForeignPtr a -> IO () -> IO () addForeignPtrConcFinalizer ForeignPtr a fObj IO () finalizer ForeignPtr a -> IO (ForeignPtr a) forall (m :: * -> *) a. Monad m => a -> m a return ForeignPtr a fObj

mallocForeignPtr :: Storable a => IO (ForeignPtr a)

mallocForeignPtr :: forall a. Storable a => IO (ForeignPtr a) mallocForeignPtr = a -> IO (ForeignPtr a) forall b. Storable b => b -> IO (ForeignPtr b) doMalloc a forall a. HasCallStack => a undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) doMalloc :: forall b. Storable b => b -> IO (ForeignPtr b) doMalloc b a | Int# -> Int I# Int# size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = String -> IO (ForeignPtr b) forall a. String -> a errorWithoutStackTrace String "mallocForeignPtr: size must be >= 0" | Bool otherwise = do IORef Finalizers r <- Finalizers -> IO (IORef Finalizers) forall a. a -> IO (IORef a) newIORef Finalizers NoFinalizers (State# RealWorld -> (# State# RealWorld, ForeignPtr b #)) -> IO (ForeignPtr b) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, ForeignPtr b #)) -> IO (ForeignPtr b)) -> (State# RealWorld -> (# State# RealWorld, ForeignPtr b #)) -> IO (ForeignPtr b) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Int# -> Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #) forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #) newAlignedPinnedByteArray# Int# size Int# align State# RealWorld s of { (# State# RealWorld s', MutableByteArray# RealWorld mbarr# #) -> (# State# RealWorld s', Addr# -> ForeignPtrContents -> ForeignPtr b forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (MutableByteArray# RealWorld -> Addr# forall d. MutableByteArray# d -> Addr# mutableByteArrayContents# MutableByteArray# RealWorld mbarr#) (MutableByteArray# RealWorld -> IORef Finalizers -> ForeignPtrContents MallocPtr MutableByteArray# RealWorld mbarr# IORef Finalizers r) #) } where !(I# Int# size) = b -> Int forall a. Storable a => a -> Int sizeOf b a !(I# Int# align) = b -> Int forall a. Storable a => a -> Int alignment b a

mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) mallocForeignPtrBytes :: forall a. Int -> IO (ForeignPtr a) mallocForeignPtrBytes Int size | Int size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = String -> IO (ForeignPtr a) forall a. String -> a errorWithoutStackTrace String "mallocForeignPtrBytes: size must be >= 0" mallocForeignPtrBytes (I# Int# size) = do IORef Finalizers r <- Finalizers -> IO (IORef Finalizers) forall a. a -> IO (IORef a) newIORef Finalizers NoFinalizers (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a)) -> (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #) forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #) newPinnedByteArray# Int# size State# RealWorld s of { (# State# RealWorld s', MutableByteArray# RealWorld mbarr# #) -> (# State# RealWorld s', Addr# -> ForeignPtrContents -> ForeignPtr a forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (MutableByteArray# RealWorld -> Addr# forall d. MutableByteArray# d -> Addr# mutableByteArrayContents# MutableByteArray# RealWorld mbarr#) (MutableByteArray# RealWorld -> IORef Finalizers -> ForeignPtrContents MallocPtr MutableByteArray# RealWorld mbarr# IORef Finalizers r) #) }

mallocForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a) mallocForeignPtrAlignedBytes :: forall a. Int -> Int -> IO (ForeignPtr a) mallocForeignPtrAlignedBytes Int size Int _align | Int size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = String -> IO (ForeignPtr a) forall a. String -> a errorWithoutStackTrace String "mallocForeignPtrAlignedBytes: size must be >= 0" mallocForeignPtrAlignedBytes (I# Int# size) (I# Int# align) = do IORef Finalizers r <- Finalizers -> IO (IORef Finalizers) forall a. a -> IO (IORef a) newIORef Finalizers NoFinalizers (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a)) -> (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Int# -> Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #) forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #) newAlignedPinnedByteArray# Int# size Int# align State# RealWorld s of { (# State# RealWorld s', MutableByteArray# RealWorld mbarr# #) -> (# State# RealWorld s', Addr# -> ForeignPtrContents -> ForeignPtr a forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (MutableByteArray# RealWorld -> Addr# forall d. MutableByteArray# d -> Addr# mutableByteArrayContents# MutableByteArray# RealWorld mbarr#) (MutableByteArray# RealWorld -> IORef Finalizers -> ForeignPtrContents MallocPtr MutableByteArray# RealWorld mbarr# IORef Finalizers r) #) }

mallocPlainForeignPtr :: Storable a => IO (ForeignPtr a) mallocPlainForeignPtr :: forall a. Storable a => IO (ForeignPtr a) mallocPlainForeignPtr = a -> IO (ForeignPtr a) forall b. Storable b => b -> IO (ForeignPtr b) doMalloc a forall a. HasCallStack => a undefined where doMalloc :: Storable b => b -> IO (ForeignPtr b) doMalloc :: forall b. Storable b => b -> IO (ForeignPtr b) doMalloc b a | Int# -> Int I# Int# size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = String -> IO (ForeignPtr b) forall a. String -> a errorWithoutStackTrace String "mallocForeignPtr: size must be >= 0" | Bool otherwise = (State# RealWorld -> (# State# RealWorld, ForeignPtr b #)) -> IO (ForeignPtr b) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, ForeignPtr b #)) -> IO (ForeignPtr b)) -> (State# RealWorld -> (# State# RealWorld, ForeignPtr b #)) -> IO (ForeignPtr b) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Int# -> Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #) forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #) newAlignedPinnedByteArray# Int# size Int# align State# RealWorld s of { (# State# RealWorld s', MutableByteArray# RealWorld mbarr# #) -> (# State# RealWorld s', Addr# -> ForeignPtrContents -> ForeignPtr b forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (MutableByteArray# RealWorld -> Addr# forall d. MutableByteArray# d -> Addr# mutableByteArrayContents# MutableByteArray# RealWorld mbarr#) (MutableByteArray# RealWorld -> ForeignPtrContents PlainPtr MutableByteArray# RealWorld mbarr#) #) } where !(I# Int# size) = b -> Int forall a. Storable a => a -> Int sizeOf b a !(I# Int# align) = b -> Int forall a. Storable a => a -> Int alignment b a

mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a) mallocPlainForeignPtrBytes :: forall a. Int -> IO (ForeignPtr a) mallocPlainForeignPtrBytes Int size | Int size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = String -> IO (ForeignPtr a) forall a. String -> a errorWithoutStackTrace String "mallocPlainForeignPtrBytes: size must be >= 0" mallocPlainForeignPtrBytes (I# Int# size) = (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a)) -> (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #) forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #) newPinnedByteArray# Int# size State# RealWorld s of { (# State# RealWorld s', MutableByteArray# RealWorld mbarr# #) -> (# State# RealWorld s', Addr# -> ForeignPtrContents -> ForeignPtr a forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (MutableByteArray# RealWorld -> Addr# forall d. MutableByteArray# d -> Addr# mutableByteArrayContents# MutableByteArray# RealWorld mbarr#) (MutableByteArray# RealWorld -> ForeignPtrContents PlainPtr MutableByteArray# RealWorld mbarr#) #) }

mallocPlainForeignPtrAlignedBytes :: Int -> Int -> IO (ForeignPtr a) mallocPlainForeignPtrAlignedBytes :: forall a. Int -> Int -> IO (ForeignPtr a) mallocPlainForeignPtrAlignedBytes Int size Int _align | Int size Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0 = String -> IO (ForeignPtr a) forall a. String -> a errorWithoutStackTrace String "mallocPlainForeignPtrAlignedBytes: size must be >= 0" mallocPlainForeignPtrAlignedBytes (I# Int# size) (I# Int# align) = (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a)) -> (State# RealWorld -> (# State# RealWorld, ForeignPtr a #)) -> IO (ForeignPtr a) forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Int# -> Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #) forall d. Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #) newAlignedPinnedByteArray# Int# size Int# align State# RealWorld s of { (# State# RealWorld s', MutableByteArray# RealWorld mbarr# #) -> (# State# RealWorld s', Addr# -> ForeignPtrContents -> ForeignPtr a forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (MutableByteArray# RealWorld -> Addr# forall d. MutableByteArray# d -> Addr# mutableByteArrayContents# MutableByteArray# RealWorld mbarr#) (MutableByteArray# RealWorld -> ForeignPtrContents PlainPtr MutableByteArray# RealWorld mbarr#) #) }

addForeignPtrFinalizer :: FinalizerPtr a -> ForeignPtr a -> IO ()

addForeignPtrFinalizer :: forall a. FinalizerPtr a -> ForeignPtr a -> IO () addForeignPtrFinalizer (FunPtr Addr# fp) (ForeignPtr Addr# p ForeignPtrContents c) = case ForeignPtrContents c of PlainForeignPtr IORef Finalizers r -> IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> () -> IO () forall value. IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer IORef Finalizers r Addr# fp Int# 0# Addr# nullAddr# Addr# p () MallocPtr MutableByteArray# RealWorld _ IORef Finalizers r -> IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> ForeignPtrContents -> IO () forall value. IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer IORef Finalizers r Addr# fp Int# 0# Addr# nullAddr# Addr# p ForeignPtrContents c ForeignPtrContents _ -> String -> IO () forall a. String -> a errorWithoutStackTrace String "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer or a final pointer"

addForeignPtrFinalizerEnv :: FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()

addForeignPtrFinalizerEnv :: forall env a. FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO () addForeignPtrFinalizerEnv (FunPtr Addr# fp) (Ptr Addr# ep) (ForeignPtr Addr# p ForeignPtrContents c) = case ForeignPtrContents c of PlainForeignPtr IORef Finalizers r -> IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> () -> IO () forall value. IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer IORef Finalizers r Addr# fp Int# 1# Addr# ep Addr# p () MallocPtr MutableByteArray# RealWorld _ IORef Finalizers r -> IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> ForeignPtrContents -> IO () forall value. IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer IORef Finalizers r Addr# fp Int# 1# Addr# ep Addr# p ForeignPtrContents c ForeignPtrContents _ -> String -> IO () forall a. String -> a errorWithoutStackTrace String "GHC.ForeignPtr: attempt to add a finalizer to a plain pointer or a final pointer"

addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()

addForeignPtrConcFinalizer :: forall a. ForeignPtr a -> IO () -> IO () addForeignPtrConcFinalizer (ForeignPtr Addr# _ ForeignPtrContents c) IO () finalizer = ForeignPtrContents -> IO () -> IO () addForeignPtrConcFinalizer_ ForeignPtrContents c IO () finalizer

addForeignPtrConcFinalizer_ :: ForeignPtrContents -> IO () -> IO () addForeignPtrConcFinalizer_ :: ForeignPtrContents -> IO () -> IO () addForeignPtrConcFinalizer_ (PlainForeignPtr IORef Finalizers r) IO () finalizer = do Bool noFinalizers <- IORef Finalizers -> IO () -> IO Bool insertHaskellFinalizer IORef Finalizers r IO () finalizer if Bool noFinalizers then (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ()) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case IORef Finalizers r of { IORef (STRef MutVar# RealWorld Finalizers r#) -> case MutVar# RealWorld Finalizers -> () -> (State# RealWorld -> (# State# RealWorld, () #)) -> State# RealWorld -> (# State# RealWorld, Weak# () #) mkWeak# MutVar# RealWorld Finalizers r# () (IO () -> State# RealWorld -> (# State# RealWorld, () #) forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #) unIO (IO () -> State# RealWorld -> (# State# RealWorld, () #)) -> IO () -> State# RealWorld -> (# State# RealWorld, () #) forall a b. (a -> b) -> a -> b $ IORef Finalizers -> IO () foreignPtrFinalizer IORef Finalizers r) State# RealWorld s of { (# State# RealWorld s1, Weak# () _ #) -> (# State# RealWorld s1, () #) }} else () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () addForeignPtrConcFinalizer_ f :: ForeignPtrContents f@(MallocPtr MutableByteArray# RealWorld fo IORef Finalizers r) IO () finalizer = do Bool noFinalizers <- IORef Finalizers -> IO () -> IO Bool insertHaskellFinalizer IORef Finalizers r IO () finalizer if Bool noFinalizers then (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ()) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case MutableByteArray# RealWorld -> () -> (State# RealWorld -> (# State# RealWorld, () #)) -> State# RealWorld -> (# State# RealWorld, Weak# () #) mkWeak# MutableByteArray# RealWorld fo () State# RealWorld -> (# State# RealWorld, () #) finalizer' State# RealWorld s of (# State# RealWorld s1, Weak# () _ #) -> (# State# RealWorld s1, () #) else () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () where finalizer' :: State# RealWorld -> (# State# RealWorld, () #) finalizer' :: State# RealWorld -> (# State# RealWorld, () #) finalizer' = IO () -> State# RealWorld -> (# State# RealWorld, () #) forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #) unIO (IORef Finalizers -> IO () foreignPtrFinalizer IORef Finalizers r IO () -> IO () -> IO () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> ForeignPtrContents -> IO () touch ForeignPtrContents f)

addForeignPtrConcFinalizer_ ForeignPtrContents _ IO () _ = String -> IO () forall a. String -> a errorWithoutStackTrace String "GHC.ForeignPtr: attempt to add a finalizer to plain pointer or a final pointer"

insertHaskellFinalizer :: IORef Finalizers -> IO () -> IO Bool insertHaskellFinalizer :: IORef Finalizers -> IO () -> IO Bool insertHaskellFinalizer IORef Finalizers r IO () f = do !Bool wasEmpty <- IORef Finalizers -> (Finalizers -> (Finalizers, Bool)) -> IO Bool forall a b. IORef a -> (a -> (a, b)) -> IO b atomicModifyIORefP IORef Finalizers r ((Finalizers -> (Finalizers, Bool)) -> IO Bool) -> (Finalizers -> (Finalizers, Bool)) -> IO Bool forall a b. (a -> b) -> a -> b $ \Finalizers finalizers -> case Finalizers finalizers of Finalizers NoFinalizers -> ([IO ()] -> Finalizers HaskellFinalizers [IO () f], Bool True) HaskellFinalizers [IO ()] fs -> ([IO ()] -> Finalizers HaskellFinalizers (IO () fIO () -> [IO ()] -> [IO ()] forall a. a -> [a] -> [a] :[IO ()] fs), Bool False) Finalizers _ -> (Finalizers, Bool) forall a. a noMixingError Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool wasEmpty

data MyWeak = MyWeak (Weak# ())

insertCFinalizer :: IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer :: forall value. IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer IORef Finalizers r Addr# fp Int# flag Addr# ep Addr# p value val = do MyWeak Weak# () w <- IORef Finalizers -> value -> IO MyWeak forall value. IORef Finalizers -> value -> IO MyWeak ensureCFinalizerWeak IORef Finalizers r value val (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ()) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Addr# -> Addr# -> Int# -> Addr# -> Weak# () -> State# RealWorld -> (# State# RealWorld, Int# #) forall b. Addr# -> Addr# -> Int# -> Addr# -> Weak# b -> State# RealWorld -> (# State# RealWorld, Int# #) addCFinalizerToWeak# Addr# fp Addr# p Int# flag Addr# ep Weak# () w State# RealWorld s of (# State# RealWorld s1, Int# 1# #) -> (# State# RealWorld s1, () #)

  (# State# RealWorld

s1, Int# _ #) -> IO () -> State# RealWorld -> (# State# RealWorld, () #) forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #) unIO (IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () forall value. IORef Finalizers -> Addr# -> Int# -> Addr# -> Addr# -> value -> IO () insertCFinalizer IORef Finalizers r Addr# fp Int# flag Addr# ep Addr# p value val) State# RealWorld s1

ensureCFinalizerWeak :: IORef Finalizers -> value -> IO MyWeak ensureCFinalizerWeak :: forall value. IORef Finalizers -> value -> IO MyWeak ensureCFinalizerWeak ref :: IORef Finalizers ref@(IORef (STRef MutVar# RealWorld Finalizers r#)) value value = do Finalizers fin <- IORef Finalizers -> IO Finalizers forall a. IORef a -> IO a readIORef IORef Finalizers ref case Finalizers fin of CFinalizers Weak# () weak -> MyWeak -> IO MyWeak forall (m :: * -> *) a. Monad m => a -> m a return (Weak# () -> MyWeak MyWeak Weak# () weak) HaskellFinalizers{} -> IO MyWeak forall a. a noMixingError Finalizers NoFinalizers -> (State# RealWorld -> (# State# RealWorld, MyWeak #)) -> IO MyWeak forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, MyWeak #)) -> IO MyWeak) -> (State# RealWorld -> (# State# RealWorld, MyWeak #)) -> IO MyWeak forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case MutVar# RealWorld Finalizers -> () -> State# RealWorld -> (# State# RealWorld, Weak# () #) mkWeakNoFinalizer# MutVar# RealWorld Finalizers r# (value -> () forall a b. a -> b unsafeCoerce value value) State# RealWorld s of { (# State# RealWorld s1, Weak# () w #) ->

      case MutVar# RealWorld Finalizers

-> (Finalizers -> (Finalizers, (MyWeak, Bool))) -> State# RealWorld -> (# State# RealWorld, Finalizers, (Finalizers, (MyWeak, Bool)) #) forall d a c. MutVar# d a -> (a -> c) -> State# d -> (# State# d, a, c #) atomicModifyMutVar2# MutVar# RealWorld Finalizers r# (Weak# () -> Finalizers -> (Finalizers, (MyWeak, Bool)) update Weak# () w) State# RealWorld s1 of { (# State# RealWorld s2, Finalizers _, (Finalizers _, (MyWeak weak, Bool needKill )) #) -> if Bool needKill then case Weak# () -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, Any #) #) forall a b. Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, b #) #) finalizeWeak# Weak# () w State# RealWorld s2 of { (# State# RealWorld s3, Int# _, State# RealWorld -> (# State# RealWorld, Any #) _ #) -> (# State# RealWorld s3, MyWeak weak #) } else (# State# RealWorld s2, MyWeak weak #) }} where update :: Weak# () -> Finalizers -> (Finalizers, (MyWeak, Bool)) update Weak# () _ fin :: Finalizers fin@(CFinalizers Weak# () w) = (Finalizers fin, (Weak# () -> MyWeak MyWeak Weak# () w, Bool True)) update Weak# () w Finalizers NoFinalizers = (Weak# () -> Finalizers CFinalizers Weak# () w, (Weak# () -> MyWeak MyWeak Weak# () w, Bool False)) update Weak# () _ Finalizers _ = (Finalizers, (MyWeak, Bool)) forall a. a noMixingError

noMixingError :: a noMixingError :: forall a. a noMixingError = String -> a forall a. String -> a errorWithoutStackTrace (String -> a) -> String -> a forall a b. (a -> b) -> a -> b $ String "GHC.ForeignPtr: attempt to mix Haskell and C finalizers " String -> ShowS forall a. [a] -> [a] -> [a] ++ String "in the same ForeignPtr"

foreignPtrFinalizer :: IORef Finalizers -> IO () foreignPtrFinalizer :: IORef Finalizers -> IO () foreignPtrFinalizer IORef Finalizers r = do Finalizers fs <- IORef Finalizers -> Finalizers -> IO Finalizers forall a. IORef a -> a -> IO a atomicSwapIORef IORef Finalizers r Finalizers NoFinalizers

case Finalizers fs of Finalizers NoFinalizers -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () CFinalizers Weak# () w -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ()) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Weak# () -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, () #) #) forall a b. Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, State# RealWorld -> (# State# RealWorld, b #) #) finalizeWeak# Weak# () w State# RealWorld s of (# State# RealWorld s1, Int# 1#, State# RealWorld -> (# State# RealWorld, () #) f #) -> State# RealWorld -> (# State# RealWorld, () #) f State# RealWorld s1 (# State# RealWorld s1, Int# _, State# RealWorld -> (# State# RealWorld, () #) _ #) -> (# State# RealWorld s1, () #) HaskellFinalizers [IO ()] actions -> [IO ()] -> IO () forall (t :: * -> *) (m :: * -> *) a. (Foldable t, Monad m) => t (m a) -> m () sequence_ [IO ()] actions

newForeignPtr_ :: Ptr a -> IO (ForeignPtr a)

newForeignPtr_ :: forall a. Ptr a -> IO (ForeignPtr a) newForeignPtr_ (Ptr Addr# obj) = do IORef Finalizers r <- Finalizers -> IO (IORef Finalizers) forall a. a -> IO (IORef a) newIORef Finalizers NoFinalizers ForeignPtr a -> IO (ForeignPtr a) forall (m :: * -> *) a. Monad m => a -> m a return (Addr# -> ForeignPtrContents -> ForeignPtr a forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr Addr# obj (IORef Finalizers -> ForeignPtrContents PlainForeignPtr IORef Finalizers r))

withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b

withForeignPtr :: forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr fo :: ForeignPtr a fo@(ForeignPtr Addr# _ ForeignPtrContents r) Ptr a -> IO b f = (State# RealWorld -> (# State# RealWorld, b #)) -> IO b forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, b #)) -> IO b) -> (State# RealWorld -> (# State# RealWorld, b #)) -> IO b forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case Ptr a -> IO b f (ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a fo) of IO State# RealWorld -> (# State# RealWorld, b #) action# -> ForeignPtrContents -> State# RealWorld -> (State# RealWorld -> (# State# RealWorld, b #)) -> (# State# RealWorld, b #) keepAlive# ForeignPtrContents r State# RealWorld s State# RealWorld -> (# State# RealWorld, b #) action#

unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b unsafeWithForeignPtr :: forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b unsafeWithForeignPtr ForeignPtr a fo Ptr a -> IO b f = do b r <- Ptr a -> IO b f (ForeignPtr a -> Ptr a forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr ForeignPtr a fo) ForeignPtr a -> IO () forall a. ForeignPtr a -> IO () touchForeignPtr ForeignPtr a fo b -> IO b forall (m :: * -> *) a. Monad m => a -> m a return b r

touchForeignPtr :: ForeignPtr a -> IO ()

touchForeignPtr :: forall a. ForeignPtr a -> IO () touchForeignPtr (ForeignPtr Addr# _ ForeignPtrContents r) = ForeignPtrContents -> IO () touch ForeignPtrContents r

touch :: ForeignPtrContents -> IO () touch :: ForeignPtrContents -> IO () touch ForeignPtrContents r = (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ()) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO () forall a b. (a -> b) -> a -> b $ \State# RealWorld s -> case ForeignPtrContents -> State# RealWorld -> State# RealWorld touch# ForeignPtrContents r State# RealWorld s of State# RealWorld s' -> (# State# RealWorld s', () #)

unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a

unsafeForeignPtrToPtr :: forall a. ForeignPtr a -> Ptr a unsafeForeignPtrToPtr (ForeignPtr Addr# fo ForeignPtrContents _) = Addr# -> Ptr a forall a. Addr# -> Ptr a Ptr Addr# fo

castForeignPtr :: ForeignPtr a -> ForeignPtr b

castForeignPtr :: forall a b. ForeignPtr a -> ForeignPtr b castForeignPtr = ForeignPtr a -> ForeignPtr b coerce

plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b

plusForeignPtr :: forall a b. ForeignPtr a -> Int -> ForeignPtr b plusForeignPtr (ForeignPtr Addr# addr ForeignPtrContents c) (I# Int# d) = Addr# -> ForeignPtrContents -> ForeignPtr b forall a. Addr# -> ForeignPtrContents -> ForeignPtr a ForeignPtr (Addr# -> Int# -> Addr# plusAddr# Addr# addr Int# d) ForeignPtrContents c

finalizeForeignPtr :: ForeignPtr a -> IO () finalizeForeignPtr :: forall a. ForeignPtr a -> IO () finalizeForeignPtr (ForeignPtr Addr# _ ForeignPtrContents c) = case ForeignPtrContents c of PlainForeignPtr IORef Finalizers ref -> IORef Finalizers -> IO () foreignPtrFinalizer IORef Finalizers ref MallocPtr MutableByteArray# RealWorld _ IORef Finalizers ref -> IORef Finalizers -> IO () foreignPtrFinalizer IORef Finalizers ref PlainPtr{} -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return () FinalPtr{} -> () -> IO () forall (m :: * -> *) a. Monad m => a -> m a return ()