X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FForeignPtr.hs;h=b91ffebf52b09f9916f351619400f0a624ceb43d;hb=f98950484a7cb01e43352e3d88277a2784cd58bf;hp=0d49fbf716102da48b66f8273df4d6801f1c3805;hpb=f7a485978f04e84b086f1974b88887cc72d832d0;p=ghc-base.git diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs index 0d49fbf..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,106 +18,98 @@ 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 + -- * Finalised data pointers + ForeignPtr + , FinalizerPtr +#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) + , FinalizerEnvPtr +#endif + -- ** Basic operations + , newForeignPtr + , newForeignPtr_ + , addForeignPtrFinalizer +#if defined(__HUGS__) || defined(__GLASGOW_HASKELL__) + , newForeignPtrEnv + , addForeignPtrFinalizerEnv +#endif + , withForeignPtr + +#ifdef __GLASGOW_HASKELL__ + , finalizeForeignPtr +#endif + + -- ** Low-level operations + , unsafeForeignPtrToPtr + , touchForeignPtr + , castForeignPtr + + -- ** Allocating managed memory + , mallocForeignPtr + , mallocForeignPtrBytes + , mallocForeignPtrArray + , mallocForeignPtrArray0 ) - where + where import Foreign.Ptr -import Data.Dynamic + +#ifdef __NHC__ +import NHC.FFI + ( ForeignPtr + , FinalizerPtr + , newForeignPtr + , newForeignPtr_ + , addForeignPtrFinalizer + , withForeignPtr + , unsafeForeignPtrToPtr + , touchForeignPtr + , castForeignPtr + , Storable(sizeOf) + , malloc, mallocBytes, finalizerFree + ) +#endif + +#ifdef __HUGS__ +import Hugs.ForeignPtr +#endif + +#ifndef __NHC__ +import Foreign.Storable ( Storable(sizeOf) ) +#endif #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.IOBase +-- import GHC.IO import GHC.Num -import GHC.Err +import GHC.Err ( undefined ) +import GHC.ForeignPtr #endif -#include "Dynamic.h" -INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") +#if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__) +import Foreign.Marshal.Alloc ( malloc, mallocBytes, finalizerFree ) -#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# +instance Eq (ForeignPtr a) where + p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q -instance CCallable (ForeignPtr a) +instance Ord (ForeignPtr a) where + compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) -eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool -eqForeignPtr (ForeignPtr fo1#) (ForeignPtr fo2#) = eqForeignObj# fo1# fo2# +instance Show (ForeignPtr a) where + showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) +#endif -instance Eq (ForeignPtr a) where - p == q = eqForeignPtr p q - p /= q = not (eqForeignPtr p q) - -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 -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, () #) } - -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, () #) +#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 @@ -128,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. @@ -139,30 +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 - -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) - -castForeignPtr :: ForeignPtr a -> ForeignPtr b --- ^This function casts a 'ForeignPtr' --- parameterised by one type into another type. -castForeignPtr (ForeignPtr a) = ForeignPtr a -#endif - +#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__ */ + +#ifndef __GLASGOW_HASKELL__ +mallocForeignPtr :: Storable a => IO (ForeignPtr a) +mallocForeignPtr = do + r <- malloc + newForeignPtr finalizerFree r + +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 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)