[project @ 2002-02-12 11:44:54 by simonmar]

[ghc-hetmet.git] / ghc / lib / std / PrelForeign.lhs

diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs
index f8a4e7b..01f135d 100644 (file)
--- a/ghc/lib/std/PrelForeign.lhs
+++ b/ghc/lib/std/PrelForeign.lhs
@@ -1,5 +1,7 @@
+% ------------------------------------------------------------------------------
+% $Id: PrelForeign.lhs,v 1.20 2001/07/16 00:39:04 sof Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
 
 \section[Foreign]{Module @Foreign@}
@@ -7,117 +9,61 @@
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
-module PrelForeign (
-       module PrelForeign,
-#ifndef __PARALLEL_HASKELL__
-       ForeignObj(..),
-       makeForeignObj,
-#endif
-       StateAndForeignObj#(..)
-   ) where
+module PrelForeign where
 
 import PrelIOBase
-import PrelST
+import PrelNum                 -- for fromInteger
 import PrelBase
-import PrelCCall
-import PrelAddr
-import PrelGHC
+import PrelPtr
 \end{code}
 
-
 %*********************************************************
 %*                                                     *
-\subsection{Type @ForeignObj@ and its operations}
+\subsection{ForeignPtr}
 %*                                                     *
 %*********************************************************
 
 \begin{code}
-#ifndef __PARALLEL_HASKELL__
---instance CCallable ForeignObj
---instance CCallable ForeignObj#
-
-eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
---makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
-writeForeignObj :: ForeignObj  -> Addr       -> IO ()
-
-{- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
-makeMallocPtr   :: Addr        -> IO ForeignObj
+data ForeignPtr a = ForeignPtr ForeignObj#
+instance CCallable (ForeignPtr a)
 
-{-
---makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
-makeForeignObj (A# obj) (A# finaliser) = IO ( \ s# ->
-    case makeForeignObj# obj finaliser s# of
-      StateAndForeignObj# s1# fo# -> IOok s1# (ForeignObj fo#))
--}
+eqForeignPtr  :: ForeignPtr a -> ForeignPtr a -> Bool
+eqForeignPtr (ForeignPtr fo1#) (ForeignPtr fo2#) = eqForeignObj# fo1# fo2#
 
-writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
-    case writeForeignObj# fo# datum# s# of { s1# -> IOok s1# () } )
+instance Eq (ForeignPtr a) where 
+    p == q = eqForeignPtr p q
+    p /= q = not (eqForeignPtr p q)
 
-makeMallocPtr a = makeForeignObj a (``&free''::Addr)
+newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
+newForeignPtr p finalizer
+  = do fObj <- mkForeignPtr p
+       addForeignPtrFinalizer fObj finalizer
+       return fObj
 
-eqForeignObj mp1 mp2
-  = unsafePerformIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
+addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
+addForeignPtrFinalizer (ForeignPtr fo) finalizer = 
+  IO $ \s -> case mkWeak# fo () finalizer s of { (# s1, w #) -> (# s1, () #) }
 
-instance Eq ForeignObj where 
-    p == q = eqForeignObj p q
-    p /= q = not (eqForeignObj p q)
-#endif /* !__PARALLEL_HASKELL__ */
-\end{code}
-
-%*********************************************************
-%*                                                     *
-\subsection{Type @StablePtr@ and its operations}
-%*                                                     *
-%*********************************************************
-
-\begin{code}
-#ifndef __PARALLEL_HASKELL__
-data StablePtr a = StablePtr (StablePtr# a)
-instance CCallable   (StablePtr a)
-instance CCallable   (StablePtr# a)
-instance CReturnable (StablePtr a)
+mkForeignPtr :: Ptr a -> IO (ForeignPtr a) {- not exported -}
+mkForeignPtr (Ptr obj) =  IO ( \ s# ->
+    case mkForeignObj# obj s# of
+      (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# #) )
 
--- Nota Bene: it is important {\em not\/} to inline calls to
--- @makeStablePtr#@ since the corresponding macro is very long and we'll
--- get terrible code-bloat.
+touchForeignPtr :: ForeignPtr a -> IO ()
+touchForeignPtr (ForeignPtr fo) 
+   = IO $ \s -> case touch# fo s of s -> (# s, () #)
 
-makeStablePtr  :: a -> IO (StablePtr a)
-deRefStablePtr :: StablePtr a -> IO a
-freeStablePtr  :: StablePtr a -> IO ()
+withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+withForeignPtr fo io
+  = do r <- io (foreignPtrToPtr fo)
+       touchForeignPtr fo
+       return r
 
-{-# INLINE deRefStablePtr #-}
-{-# INLINE freeStablePtr #-}
+foreignPtrToPtr :: ForeignPtr a -> Ptr a
+foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo)
 
-makeStablePtr f = IO $ \ rw1# ->
-    case makeStablePtr# f rw1# of
-      StateAndStablePtr# rw2# sp# -> IOok rw2# (StablePtr sp#)
+castForeignPtr (ForeignPtr a) = ForeignPtr a
 
-deRefStablePtr (StablePtr sp#) = IO $ \ rw1# ->
-    case deRefStablePtr# sp# rw1# of
-      StateAndPtr# rw2# a -> IOok rw2# a
-
-freeStablePtr sp = _ccall_ freeStablePointer sp
-
-eqStablePtr :: StablePtr a -> StablePtr b -> Bool
-eqStablePtr s1 s2
-  = unsafePerformIO (_ccall_ eqStablePtr s1 s2) /= (0::Int)
-
-instance Eq (StablePtr a) where 
-    p == q = eqStablePtr p q
-    p /= q = not (eqStablePtr p q)
-
-#endif /* !__PARALLEL_HASKELL__ */
 \end{code}
 
-%*********************************************************
-%*                                                     *
-\subsection{Ghastly return types}
-%*                                                     *
-%*********************************************************
 
-\begin{code}
-#ifndef __PARALLEL_HASKELL__
-data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
-#endif
---data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
-\end{code}