X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FForeignPtr.hs;h=a545396412e7d7d158bb6befca88e769896a781b;hb=57e487c332d1f428ee5ff85dbb32730d25a58235;hp=6b3fb88c37ebc80bdef63c375c2bff65a3156ebb;hpb=2fec6a84226c1b78239e99a3883e31faedb62f46;p=ghc-base.git diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs index 6b3fb88..a545396 100644 --- a/Foreign/ForeignPtr.hs +++ b/Foreign/ForeignPtr.hs @@ -18,107 +18,89 @@ 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 + ForeignPtr + , FinalizerPtr + , newForeignPtr + , newForeignPtr_ + , addForeignPtrFinalizer + , withForeignPtr + , unsafeForeignPtrToPtr + , touchForeignPtr + , castForeignPtr + + , mallocForeignPtr + , mallocForeignPtrBytes + , mallocForeignPtrArray + , mallocForeignPtrArray0 ) 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.Num -import GHC.Ptr ( Ptr(..) ) -import GHC.Err +import GHC.Err ( undefined ) +import GHC.ForeignPtr #endif +#if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__) +import Foreign.Marshal.Alloc ( malloc, mallocBytes, finalizerFree ) +import Data.Dynamic + #include "Dynamic.h" INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") -#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 Ord (ForeignPtr a) where + compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) -instance CCallable (ForeignPtr a) +instance Show (ForeignPtr a) where + showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) +#endif -eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool -eqForeignPtr (ForeignPtr fo1#) (ForeignPtr fo2#) = eqForeignObj# fo1# fo2# -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 +#ifndef __NHC__ +newForeignPtr :: Ptr a -> FinalizerPtr a -> IO (ForeignPtr a) +-- ^Turns a plain memory reference into a foreign pointer, and +-- associates a finaliser 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 + = do fObj <- newForeignPtr_ 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, () #) - withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- ^This is a way to look at the pointer living inside a -- foreign object. This function takes a function which is @@ -130,7 +112,7 @@ withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -- of the pointer should be inside the -- 'withForeignPtr' bracket. The reason for -- this unsafety is the same as for --- 'foreignPtrToPtr' below: the finalizer +-- '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. @@ -140,30 +122,28 @@ 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__ */ + +#ifndef __GLASGOW_HASKELL__ +mallocForeignPtr :: Storable a => IO (ForeignPtr a) +mallocForeignPtr = do + r <- malloc + newForeignPtr r finalizerFree + +mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocForeignPtrBytes n = do + r <- mallocBytes n + newForeignPtr r finalizerFree +#endif /* __HUGS__ || __NHC__ */ + +mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a) +mallocForeignPtrArray = doMalloc undefined + where + doMalloc :: Storable a => a -> Int -> IO (ForeignPtr a) + doMalloc dummy size = mallocForeignPtrBytes (size * sizeOf dummy) + +mallocForeignPtrArray0 :: Storable a => Int -> IO (ForeignPtr a) +mallocForeignPtrArray0 size = mallocForeignPtrArray (size + 1)