X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelForeign.lhs;h=01f135df5c1bcecab5d728d8bfc33c75492f7cd1;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=57af782f56989e8de792cae856b6d2afe269e99d;hpb=6111556816314236f1f7df84b404e6fbc83e739f;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs
index 57af782..01f135d 100644
--- 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,94 +9,61 @@
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
-module PrelForeign (
-	module PrelForeign,
-#ifndef __PARALLEL_HASKELL__
-	ForeignObj(..),
-	makeForeignObj,
-	-- SUP: deprecated
-	mkForeignObj,
-	writeForeignObj
-#endif
-   ) where
+module PrelForeign where
 
 import PrelIOBase
-import PrelST
+import PrelNum			-- for fromInteger
 import PrelBase
-import PrelAddr
-import PrelGHC
-import PrelWeak	( addForeignFinalizer )
+import PrelPtr
 \end{code}
 
-
 %*********************************************************
 %*							*
-\subsection{Type @ForeignObj@ and its operations}
+\subsection{ForeignPtr}
 %*							*
 %*********************************************************
 
-mkForeignObj and writeForeignObj are the building blocks
-for makeForeignObj, they can probably be nuked in the future.
-
 \begin{code}
-#ifndef __PARALLEL_HASKELL__
---instance CCallable ForeignObj
---instance CCallable ForeignObj#
-
-makeForeignObj :: Addr -> IO () -> IO ForeignObj
-makeForeignObj addr finalizer = do
-   fObj <- mkForeignObj addr
-   addForeignFinalizer fObj finalizer
-   return fObj
-
-mkForeignObj  :: Addr -> IO ForeignObj
-mkForeignObj (A# obj) = IO ( \ s# ->
+data ForeignPtr a = ForeignPtr ForeignObj#
+instance CCallable (ForeignPtr a)
+
+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)
+newForeignPtr p finalizer
+  = do fObj <- mkForeignPtr p
+       addForeignPtrFinalizer fObj finalizer
+       return fObj
+
+addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
+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#,  ForeignObj fo# #) )
+      (# s1#, fo# #) -> (# s1#,  ForeignPtr fo# #) )
 
-writeForeignObj :: ForeignObj -> Addr -> IO ()
-writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
-    case writeForeignObj# fo# datum# s# of { s1# -> (# s1#, () #) } )
-#endif /* !__PARALLEL_HASKELL__ */
-\end{code}
+touchForeignPtr :: ForeignPtr a -> IO ()
+touchForeignPtr (ForeignPtr fo) 
+   = IO $ \s -> case touch# fo s of s -> (# s, () #)
 
-%*********************************************************
-%*							*
-\subsection{Unpacking Foreigns}
-%*							*
-%*********************************************************
+withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
+withForeignPtr fo io
+  = do r <- io (foreignPtrToPtr fo)
+       touchForeignPtr fo
+       return r
 
-Primitives for converting Foreigns pointing to external
-sequence of bytes into a list of @Char@s (a renamed version
-of the code above).
+foreignPtrToPtr :: ForeignPtr a -> Ptr a
+foreignPtrToPtr (ForeignPtr fo) = Ptr (foreignObjToAddr# fo)
+
+castForeignPtr (ForeignPtr a) = ForeignPtr a
 
-\begin{code}
-#ifndef __PARALLEL_HASKELL__
-unpackCStringFO :: ForeignObj -> [Char]
-unpackCStringFO (ForeignObj fo#) = unpackCStringFO# fo#
-
-unpackCStringFO# :: ForeignObj# -> [Char]
-unpackCStringFO# fo {- ptr. to NUL terminated string-}
-  = unpack 0#
-  where
-    unpack nh
-      | ch `eqChar#` '\0'# = []
-      | otherwise	   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharOffForeignObj# fo nh
-
-unpackNBytesFO :: ForeignObj -> Int -> [Char]
-unpackNBytesFO (ForeignObj fo) (I# l) = unpackNBytesFO# fo l
-
-unpackNBytesFO#    :: ForeignObj# -> Int#   -> [Char]
-  -- This one is called by the compiler to unpack literal strings with NULs in them; rare.
-unpackNBytesFO# fo len
-  = unpack 0#
-    where
-     unpack i
-      | i >=# len  = []
-      | otherwise  = C# ch : unpack (i +# 1#)
-      where
-	ch = indexCharOffForeignObj# fo i
-#endif
 \end{code}
+
+