X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FForeignPtr.hs;h=b91ffebf52b09f9916f351619400f0a624ceb43d;hb=755c6efb0bfac5c176ac9af1a5abab98001a17da;hp=a60358788e95196a7eeb1377dbd0690bd1246756;hpb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;p=ghc-base.git diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs index a603587..b91ffeb 100644 --- a/Foreign/ForeignPtr.hs +++ b/Foreign/ForeignPtr.hs @@ -1,84 +1,180 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.ForeignPtr -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- --- $Id: ForeignPtr.hs,v 1.4 2002/04/24 16:31:44 simonmar Exp $ --- --- This module defines foreign pointers, i.e. addresses with associated --- finalizers. +-- The 'ForeignPtr' type and operations. This module is part of the +-- Foreign Function Interface (FFI) and will usually be imported via +-- the "Foreign" module. -- ----------------------------------------------------------------------------- module Foreign.ForeignPtr - ( 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 __GLASGOW_HASKELL__ -import GHC.Base -import GHC.IOBase -import GHC.Num -import GHC.Err +#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 -#include "Dynamic.h" -INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr") +#ifndef __NHC__ +import Foreign.Storable ( Storable(sizeOf) ) +#endif #ifdef __GLASGOW_HASKELL__ -data ForeignPtr a = ForeignPtr ForeignObj# -instance CCallable (ForeignPtr a) +import GHC.Base +-- import GHC.IO +import GHC.Num +import GHC.Err ( undefined ) +import GHC.ForeignPtr +#endif -eqForeignPtr :: ForeignPtr a -> ForeignPtr a -> Bool -eqForeignPtr (ForeignPtr fo1#) (ForeignPtr fo2#) = eqForeignObj# fo1# fo2# +#if !defined(__NHC__) && !defined(__GLASGOW_HASKELL__) +import Foreign.Marshal.Alloc ( malloc, mallocBytes, finalizerFree ) instance Eq (ForeignPtr a) where - p == q = eqForeignPtr p q - p /= q = not (eqForeignPtr p q) + p == q = unsafeForeignPtrToPtr p == unsafeForeignPtrToPtr q -newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a) -newForeignPtr p finalizer - = do fObj <- mkForeignPtr p - addForeignPtrFinalizer fObj finalizer - return fObj +instance Ord (ForeignPtr a) where + compare p q = compare (unsafeForeignPtrToPtr p) (unsafeForeignPtrToPtr q) -addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO () -addForeignPtrFinalizer (ForeignPtr fo) finalizer = - IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) } +instance Show (ForeignPtr a) where + showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f) +#endif -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 () -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 +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- 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. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- '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 -foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo) +#ifndef __GLASGOW_HASKELL__ +mallocForeignPtr :: Storable a => IO (ForeignPtr a) +mallocForeignPtr = do + r <- malloc + newForeignPtr finalizerFree r -castForeignPtr (ForeignPtr a) = ForeignPtr a -#endif +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)