[project @ 2003-03-26 15:25:46 by simonmar]
authorsimonmar <unknown>
Wed, 26 Mar 2003 15:25:46 +0000 (15:25 +0000)
committersimonmar <unknown>
Wed, 26 Mar 2003 15:25:46 +0000 (15:25 +0000)
Change our ForeignPtr implementation to match the spec: finalizers
must now be foreign functions.

Move the old Haskell-finalizer versions of newForeignPtr and
addForeignPtrFinalizer into Foreign.Concurrent, to make it clear that
the implementations of these functions require concurrency.

While I'm here: move the GHC-specific parts of the ForeignPtr
implementation into GHC.ForeignPtr.

Foreign/Concurrent.hs [new file with mode: 0644]
GHC/ForeignPtr.hs [new file with mode: 0644]
Text/Regex/Posix.hsc

diff --git a/Foreign/Concurrent.hs b/Foreign/Concurrent.hs
new file mode 100644 (file)
index 0000000..6d484e0
--- /dev/null
@@ -0,0 +1,32 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Foreign.Concurrent
+-- Copyright   :  (c) The University of Glasgow 2003
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  ffi@haskell.org
+-- Stability   :  provisional
+-- Portability :  non-portable (requires concurrency)
+--
+-- FFI datatypes and operations that use or require concurrency.
+--
+-----------------------------------------------------------------------------
+
+module Foreign.Concurrent
+  (
+       -- * Concurrency-based @ForeignPtr@ operations
+#ifdef __GLASGOW_HASKELL__
+       newForeignPtr,
+       addForeignPtrFinalizer,
+#endif
+  ) where
+
+#ifdef __GLASGOW_HASKELL__
+import qualified GHC.ForeignPtr
+#endif
+
+#ifdef __GLASGOW_HASKELL__
+newForeignPtr          = GHC.ForeignPtr.newConcForeignPtr
+addForeignPtrFinalizer = GHC.ForeignPtr.addForeignPtrConcFinalizer
+#endif
diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
new file mode 100644 (file)
index 0000000..dad5f04
--- /dev/null
@@ -0,0 +1,259 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.ForeignPtr
+-- Copyright   :  (c) The University of Glasgow, 1992-2003
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  cvs-ghc@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable (GHC extensions)
+--
+-- GHC's implementation of the 'ForeignPtr' data type.
+-- 
+-----------------------------------------------------------------------------
+
+module GHC.ForeignPtr
+  (
+       ForeignPtr(..),
+       newForeignPtr,
+       mallocForeignPtr,
+       mallocForeignPtrBytes,
+       addForeignPtrFinalizer, 
+       touchForeignPtr,
+       withForeignPtr,
+       foreignPtrToPtr,
+       castForeignPtr,
+       newConcForeignPtr,
+       addForeignPtrConcFinalizer,
+  ) where
+
+import Control.Monad   ( sequence_ )
+import Foreign.Ptr
+import Foreign.Storable
+import Data.Dynamic
+
+import GHC.List        ( null )
+import GHC.Base
+import GHC.IOBase
+import GHC.Ptr         ( Ptr(..) )
+import GHC.Err
+import GHC.Show
+
+-- |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# !(IORef [IO ()])
+  | MallocPtr (MutableByteArray# RealWorld) !(IORef [IO ()])
+
+instance Eq (ForeignPtr a) where
+    p == q  =  foreignPtrToPtr p == foreignPtrToPtr q
+
+instance Ord (ForeignPtr a) where
+    compare p q  =  compare (foreignPtrToPtr p) (foreignPtrToPtr q)
+
+instance Show (ForeignPtr a) where
+    showsPrec p f = showsPrec p (foreignPtrToPtr f)
+
+#include "Dynamic.h"
+INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
+
+newForeignPtr :: Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr a)
+-- ^Turns a plain memory reference into a foreign object by
+-- associating a finaliser - a foreign function given by the @FunPtr@
+-- - 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
+
+newConcForeignPtr :: 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.
+--
+-- The finalizer, when invoked, will run in a separate thread.
+--
+newConcForeignPtr p finalizer
+  = do fObj <- mkForeignPtr p
+       addForeignPtrConcFinalizer fObj finalizer
+       return fObj
+
+mallocForeignPtr :: Storable a => IO (ForeignPtr a)
+-- ^ 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 = doMalloc undefined
+  where doMalloc :: Storable a => a -> IO (ForeignPtr a)
+        doMalloc a = do
+         r <- newIORef []
+         IO $ \s ->
+           case newPinnedByteArray# size s of { (# s, mbarr# #) ->
+            (# s, MallocPtr mbarr# r #)
+            }
+           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) = do 
+  r <- newIORef []
+  IO $ \s ->
+     case newPinnedByteArray# size s      of { (# s, mbarr# #) ->
+       (# s, MallocPtr mbarr# r #)
+     }
+
+addForeignPtrFinalizer :: ForeignPtr a -> FunPtr (Ptr a -> IO ()) -> IO ()
+-- ^This function adds a finaliser to the given foreign object.  The
+-- finalizer will run /before/ all other finalizers for the same
+-- object which have already been registered.
+addForeignPtrFinalizer fptr finalizer = 
+  addForeignPtrConcFinalizer fptr 
+       (mkFinalizer finalizer (foreignPtrToPtr fptr))
+
+addForeignPtrConcFinalizer :: ForeignPtr a -> IO () -> IO ()
+-- ^This function adds a finaliser to the given @ForeignPtr@.  The
+-- finalizer will run /before/ all other finalizers for the same
+-- object which have already been registered.
+--
+-- This is a variant of @addForeignPtrFinalizer@, where the finalizer
+-- is an arbitrary @IO@ action.  When it is invoked, the finalizer
+-- will run in a new thread.
+--
+addForeignPtrConcFinalizer f@(ForeignPtr fo r) finalizer = do
+  fs <- readIORef r
+  writeIORef r (finalizer : fs)
+  if (null fs)
+     then IO $ \s ->
+             let p = foreignPtrToPtr f in
+             case mkWeak# fo () (foreignPtrFinalizer r p) s of 
+                (# s1, w #) -> (# s1, () #)
+     else return ()
+addForeignPtrConcFinalizer f@(MallocPtr fo r) finalizer = do 
+  fs <- readIORef r
+  writeIORef r (finalizer : fs)
+  if (null fs)
+     then  IO $ \s -> 
+              let p = foreignPtrToPtr f in
+              case mkWeak# fo () (foreignPtrFinalizer r p) s of 
+                 (# s1, w #) -> (# s1, () #)
+     else return ()
+
+foreign import ccall "dynamic" 
+  mkFinalizer :: FunPtr (Ptr a -> IO ()) -> Ptr a -> IO ()
+
+foreignPtrFinalizer :: IORef [IO ()] -> Ptr a -> IO ()
+foreignPtrFinalizer r p = do
+  fs <- readIORef r
+  sequence_ fs
+
+mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -}
+mkForeignPtr (Ptr obj) =  do
+  r <- newIORef []
+  IO $ \ s# ->
+    case mkForeignObj# obj s# of
+      (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# r #)
+
+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 r)
+   = IO $ \s -> case touch# fo s of s -> (# s, () #)
+touchForeignPtr (MallocPtr fo r)
+   = 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
+-- 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
+-- 'foreignPtrToPtr' 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)
+       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 r) = Ptr (foreignObjToAddr# fo)
+foreignPtrToPtr (MallocPtr  fo r) = Ptr (byteArrayContents# (unsafeCoerce# fo))
+
+castForeignPtr :: ForeignPtr a -> ForeignPtr b
+-- ^This function casts a 'ForeignPtr'
+-- parameterised by one type into another type.
+castForeignPtr f = unsafeCoerce# f
index 8d2fc53..506a9ef 100644 (file)
@@ -56,29 +56,15 @@ regcomp
   -> Int       -- ^ Flags (summed together)
   -> IO Regex          -- ^ Returns: the compiled regular expression
 regcomp pattern flags = do
-#ifdef __HUGS__
   regex_fptr <- mallocForeignPtrBytes (#const sizeof(regex_t))
-#else
-  regex_ptr <- mallocBytes (#const sizeof(regex_t))
-  regex_fptr <- newForeignPtr regex_ptr (regfree regex_ptr)
-#endif /* __HUGS__ */
   r <- withCString pattern $ \cstr ->
         withForeignPtr regex_fptr $ \p ->
            c_regcomp p cstr (fromIntegral flags)
-#ifdef __HUGS__
   addForeignPtrFinalizer regex_fptr ptr_regfree
-#endif
   if (r == 0)
      then return (Regex regex_fptr)
      else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo
 
-#ifndef __HUGS__
-regfree :: Ptr CRegex -> IO ()
-regfree p_regex = do
-  c_regfree p_regex
-  free p_regex
-#endif /* __HUGS__ */
-
 -- -----------------------------------------------------------------------------
 -- regexec
 
@@ -174,13 +160,8 @@ type CRegMatch = ()
 foreign import ccall unsafe "regcomp"
   c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
 
-#ifdef __HUGS__
 foreign import ccall  unsafe "&regfree"
   ptr_regfree :: FunPtr (Ptr CRegex -> IO ())
-#else
-foreign import ccall  unsafe "regfree"
-  c_regfree :: Ptr CRegex -> IO ()
-#endif /* __HUGS__ */
 
 foreign import ccall unsafe "regexec"
   c_regexec :: Ptr CRegex -> CString -> CSize