X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FForeignPtr.hs;h=b91ffebf52b09f9916f351619400f0a624ceb43d;hb=41e8fba828acbae1751628af50849f5352b27873;hp=a1e85507b928244e7a3c62bb32276b5f8a6400b1;hpb=dc973410f9f28e34f3df1bbe76cee9592204c95b;p=ghc-base.git diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs index a1e8550..b91ffeb 100644 --- a/Foreign/ForeignPtr.hs +++ b/Foreign/ForeignPtr.hs @@ -1,4 +1,5 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.ForeignPtr @@ -17,48 +18,54 @@ module Foreign.ForeignPtr ( - -- * Finalised data pointers - ForeignPtr -- abstract, instance of: Eq - , newForeignPtr -- :: Ptr a -> IO () -> IO (ForeignPtr a) - , addForeignPtrFinalizer -- :: ForeignPtr a -> IO () -> IO () - , withForeignPtr -- :: ForeignPtr a -> (Ptr a -> IO b) -> IO b - , foreignPtrToPtr -- :: ForeignPtr a -> Ptr a - , touchForeignPtr -- :: ForeignPtr a -> IO () - , castForeignPtr -- :: ForeignPtr a -> ForeignPtr b - -#ifndef __NHC__ - , mallocForeignPtr -- :: Storable a => IO (ForeignPtr a) - , mallocForeignPtrBytes -- :: Int -> IO (ForeignPtr a) - , mallocForeignPtrArray -- :: Storable a => Int -> IO (ForeignPtr a) - , mallocForeignPtrArray0 -- :: Storable a => Int -> IO (ForeignPtr a) + -- * Finalised data pointers + ForeignPtr + , FinalizerPtr +#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) + , FinalizerEnvPtr #endif - ) - where - -#ifndef __NHC__ -import Foreign.Ptr -import Foreign.Storable -import Data.Dynamic + -- ** Basic operations + , newForeignPtr + , newForeignPtr_ + , addForeignPtrFinalizer +#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) + , newForeignPtrEnv + , addForeignPtrFinalizerEnv #endif + , withForeignPtr #ifdef __GLASGOW_HASKELL__ -import GHC.Base -import GHC.IOBase -import GHC.Num -import GHC.Ptr ( Ptr(..) ) -import GHC.Err -import GHC.Show + , finalizeForeignPtr #endif + -- ** Low-level operations + , unsafeForeignPtrToPtr + , touchForeignPtr + , castForeignPtr + + -- ** Allocating managed memory + , mallocForeignPtr + , mallocForeignPtrBytes + , mallocForeignPtrArray + , mallocForeignPtrArray0 + ) + where + +import Foreign.Ptr + #ifdef __NHC__ import NHC.FFI ( ForeignPtr + , FinalizerPtr , newForeignPtr + , newForeignPtr_ , addForeignPtrFinalizer , withForeignPtr - , foreignPtrToPtr + , unsafeForeignPtrToPtr , touchForeignPtr , castForeignPtr + , Storable(sizeOf) + , malloc, mallocBytes, finalizerFree ) #endif @@ -67,118 +74,42 @@ import Hugs.ForeignPtr #endif #ifndef __NHC__ -#include "Dynamic.h" -INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") +import Foreign.Storable ( Storable(sizeOf) ) #endif #ifdef __GLASGOW_HASKELL__ --- |The type 'ForeignPtr' represents references to objects that are --- maintained in a foreign language, i.e., that are not part of the --- data structures usually managed by the Haskell storage manager. --- The essential difference between 'ForeignPtr's and vanilla memory --- references of type @Ptr a@ is that the former may be associated --- with /finalisers/. A finaliser is a routine that is invoked when --- the Haskell storage manager detects that - within the Haskell heap --- and stack - there are no more references left that are pointing to --- the 'ForeignPtr'. Typically, the finaliser will, then, invoke --- routines in the foreign language that free the resources bound by --- the foreign object. --- --- The 'ForeignPtr' is parameterised in the same way as 'Ptr'. The --- type argument of 'ForeignPtr' should normally be an instance of --- class 'Storable'. --- -data ForeignPtr a - = ForeignPtr ForeignObj# - | MallocPtr (MutableByteArray# RealWorld) +import GHC.Base +-- import GHC.IO +import GHC.Num +import GHC.Err ( undefined ) +import GHC.ForeignPtr +#endif + +#if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__) +import Foreign.Marshal.Alloc ( malloc, mallocBytes, finalizerFree ) instance Eq (ForeignPtr a) where - p == q = foreignPtrToPtr p == foreignPtrToPtr q + p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q + +instance Ord (ForeignPtr a) where + compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) instance Show (ForeignPtr a) where - showsPrec p f = showsPrec p (foreignPtrToPtr f) - - -newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a) --- ^Turns a plain memory reference into a foreign object --- by associating a finaliser - given by the monadic operation --- - with the reference. The finaliser will be executed after --- the last reference to the foreign object is dropped. Note --- that there is no guarantee on how soon the finaliser is --- executed after the last reference was dropped; this depends --- on the details of the Haskell storage manager. The only --- guarantee is that the finaliser runs before the program --- terminates. -newForeignPtr p finalizer - = do fObj <- mkForeignPtr p - addForeignPtrFinalizer fObj finalizer - return fObj + showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) +#endif --- | allocates some memory and returns a ForeignPtr to it. The memory --- will be released automatically when the ForeignPtr is discarded. --- --- @mallocForeignPtr@ is equivalent to --- --- > do { p <- malloc; newForeignPtr p free } --- --- although it may be implemented differently internally. You may not --- assume that the memory returned by 'mallocForeignPtr' has been --- allocated with C's @malloc()@. -mallocForeignPtr :: Storable a => IO (ForeignPtr a) -mallocForeignPtr = doMalloc undefined - where doMalloc :: Storable a => a -> IO (ForeignPtr a) - doMalloc a = IO $ \s -> - case newPinnedByteArray# size s of { (# s, mbarr# #) -> - (# s, MallocPtr mbarr# #) - } - where (I# size) = sizeOf a - --- | similar to 'mallocForeignPtr', except that the size of the memory required --- is given explicitly as a number of bytes. -mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) -mallocForeignPtrBytes (I# size) = IO $ \s -> - case newPinnedByteArray# size s of { (# s, mbarr# #) -> - (# s, MallocPtr mbarr# #) - } - -addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO () --- ^This function adds another finaliser to the given --- foreign object. No guarantees are made on the order in --- which multiple finalisers for a single object are run. -addForeignPtrFinalizer (ForeignPtr fo) finalizer = - IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) } -addForeignPtrFinalizer (MallocPtr fo) finalizer = - IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) } - -mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -} -mkForeignPtr (Ptr obj) = IO ( \ s# -> - case mkForeignObj# obj s# of - (# s1#, fo# #) -> (# s1#, ForeignPtr fo# #) ) - -touchForeignPtr :: ForeignPtr a -> IO () --- ^This function ensures that the foreign object in --- question is alive at the given place in the sequence of IO --- actions. In particular 'withForeignPtr' --- does a 'touchForeignPtr' after it --- executes the user action. --- --- This function can be used to express liveness --- dependencies between 'ForeignPtr's: for --- example, if the finalizer for one --- 'ForeignPtr' touches a second --- 'ForeignPtr', then it is ensured that the --- second 'ForeignPtr' will stay alive at --- least as long as the first. This can be useful when you --- want to manipulate /interior pointers/ to --- a foreign structure: you can use --- 'touchForeignObj' to express the --- requirement that the exterior pointer must not be finalized --- until the interior pointer is no longer referenced. -touchForeignPtr (ForeignPtr fo) - = IO $ \s -> case touch# fo s of s -> (# s, () #) -touchForeignPtr (MallocPtr fo) - = IO $ \s -> case touch# fo s of s -> (# s, () #) +#ifndef __NHC__ +newForeignPtr :: FinalizerPtr a -> Ptr a -> IO (ForeignPtr a) +-- ^Turns a plain memory reference into a foreign pointer, and +-- associates a finalizer with the reference. The finalizer will be +-- executed after the last reference to the foreign object is dropped. +-- There is no guarantee of promptness, however the finalizer will be +-- executed before the program exits. +newForeignPtr finalizer p + = do fObj <- newForeignPtr_ p + addForeignPtrFinalizer finalizer fObj + return fObj withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- ^This is a way to look at the pointer living inside a @@ -190,8 +121,8 @@ withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- the action and use it after the action completes. All uses -- of the pointer should be inside the -- 'withForeignPtr' bracket. The reason for --- this unsafety is the same as for --- 'foreignPtrToPtr' below: the finalizer +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer -- may run earlier than expected, because the compiler can only -- track usage of the 'ForeignPtr' object, not -- a 'Ptr' object made from it. @@ -201,42 +132,49 @@ withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- 'ForeignPtr', using the operations from the -- 'Storable' class. withForeignPtr fo io - = do r <- io (foreignPtrToPtr fo) + = do r <- io (unsafeForeignPtrToPtr fo) touchForeignPtr fo return r +#endif /* ! __NHC__ */ + +#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) +-- | This variant of 'newForeignPtr' adds a finalizer that expects an +-- environment in addition to the finalized pointer. The environment +-- that will be passed to the finalizer is fixed by the second argument to +-- 'newForeignPtrEnv'. +newForeignPtrEnv :: + FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a) +newForeignPtrEnv finalizer env p + = do fObj <- newForeignPtr_ p + addForeignPtrFinalizerEnv finalizer env fObj + return fObj +#endif /* __HUGS__ */ -foreignPtrToPtr :: ForeignPtr a -> Ptr a --- ^This function extracts the pointer component of a foreign --- pointer. This is a potentially dangerous operations, as if the --- argument to 'foreignPtrToPtr' is the last usage --- occurence of the given foreign pointer, then its finaliser(s) will --- be run, which potentially invalidates the plain pointer just --- obtained. Hence, 'touchForeignPtr' must be used --- wherever it has to be guaranteed that the pointer lives on - i.e., --- has another usage occurrence. --- --- To avoid subtle coding errors, hand written marshalling code --- should preferably use 'withForeignPtr' rather --- than combinations of 'foreignPtrToPtr' and --- 'touchForeignPtr'. However, the later routines --- are occasionally preferred in tool generated marshalling code. -foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo) -foreignPtrToPtr (MallocPtr fo) = Ptr (byteArrayContents# (unsafeCoerce# fo)) - -castForeignPtr :: ForeignPtr a -> ForeignPtr b --- ^This function casts a 'ForeignPtr' --- parameterised by one type into another type. -castForeignPtr (ForeignPtr a) = ForeignPtr a -castForeignPtr (MallocPtr a) = MallocPtr a -#endif +#ifndef __GLASGOW_HASKELL__ +mallocForeignPtr :: Storable a => IO (ForeignPtr a) +mallocForeignPtr = do + r <- malloc + newForeignPtr finalizerFree r -#ifndef __NHC__ +mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocForeignPtrBytes n = do + r <- mallocBytes n + newForeignPtr finalizerFree r +#endif /* !__GLASGOW_HASKELL__ */ + +-- | This function is similar to 'Foreign.Marshal.Array.mallocArray', +-- but yields a memory area that has a finalizer attached that releases +-- the memory area. As with 'mallocForeignPtr', it is not guaranteed that +-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'. mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a) mallocForeignPtrArray = doMalloc undefined where - doMalloc :: Storable a => a -> Int -> IO (ForeignPtr a) + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) doMalloc dummy size = mallocForeignPtrBytes (size * sizeOf dummy) +-- | This function is similar to 'Foreign.Marshal.Array.mallocArray0', +-- but yields a memory area that has a finalizer attached that releases +-- the memory area. As with 'mallocForeignPtr', it is not guaranteed that +-- the block of memory was allocated by 'Foreign.Marshal.Alloc.malloc'. mallocForeignPtrArray0 :: Storable a => Int -> IO (ForeignPtr a) mallocForeignPtrArray0 size = mallocForeignPtrArray (size + 1) -#endif