% ------------------------------------------------------------------------------
-% $Id: PrelForeign.lhs,v 1.15 2000/06/30 13:39:35 simonmar Exp $
+% $Id: PrelForeign.lhs,v 1.19 2001/05/18 16:54:05 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2000
%
\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 PrelNum -- for fromInteger
import PrelBase
-import PrelAddr
-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 mp1 mp2
+ = unsafePerformIO (primEqForeignPtr mp1 mp2) /= (0::Int)
+
+foreign import "eqForeignObj" unsafe
+ primEqForeignPtr :: ForeignPtr a -> ForeignPtr a -> IO Int
+
+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}
+
+