[project @ 2003-06-12 10:53:15 by simonmar]

[haskell-directory.git] / Foreign / ForeignPtr.hs

diff --git a/Foreign/ForeignPtr.hs b/Foreign/ForeignPtr.hs
index 1941d8f..01c5c09 100644 (file)
--- a/Foreign/ForeignPtr.hs
+++ b/Foreign/ForeignPtr.hs
@@ -19,10 +19,12 @@ module Foreign.ForeignPtr
         ( 
        -- * Finalised data pointers
          ForeignPtr
+       , FinalizerPtr
         , newForeignPtr
+        , newForeignPtr_
         , addForeignPtrFinalizer
        , withForeignPtr
-       , foreignPtrToPtr
+       , unsafeForeignPtrToPtr
        , touchForeignPtr
        , castForeignPtr
 
@@ -35,22 +37,21 @@ module Foreign.ForeignPtr
         ) 
        where
 
+import Foreign.Ptr
+
 #ifdef __NHC__
 import NHC.FFI
   ( ForeignPtr
+  , FinalizerPtr
   , newForeignPtr
   , addForeignPtrFinalizer
   , withForeignPtr
-  , foreignPtrToPtr
+  , unsafeForeignPtrToPtr
   , touchForeignPtr
   , castForeignPtr
   )
 #endif
 
-#ifdef __GLASGOW_HASKELL__
-import GHC.ForeignPtr
-#endif
-
 #ifdef __HUGS__
 import Hugs.ForeignPtr
 #endif
@@ -64,8 +65,71 @@ import GHC.Base
 import GHC.IOBase
 import GHC.Num
 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")
+
+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 Show (ForeignPtr a) where
+    showsPrec p f = showsPrec p (unsafeForeignPtrToPtr f)
 #endif
 
+
+#ifndef __NHC__
+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 unsafety 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 (unsafeForeignPtrToPtr fo)
+       touchForeignPtr fo
+       return r
+#endif /* ! __NHC__ */
+
+#ifdef __HUGS__
+-- temporary aliasing until hugs catches up
+unsafeForeignPtrToPtr = foreignPtrToPtr
+#endif
+
+#ifdef __HUGS__
+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__ */
+
 #ifndef __NHC__
 mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)
 mallocForeignPtrArray  = doMalloc undefined