[project @ 1998-08-14 12:57:27 by sof]

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

diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs
index 6a78c84..f8a4e7b 100644 (file)
--- a/ghc/lib/std/PrelForeign.lhs
+++ b/ghc/lib/std/PrelForeign.lhs
@@ -11,15 +11,9 @@ module PrelForeign (
        module PrelForeign,
 #ifndef __PARALLEL_HASKELL__
        ForeignObj(..),
+       makeForeignObj,
 #endif
-       Word(..),
-
-#ifndef __PARALLEL_HASKELL__
-       unpackCStringFO,   -- :: ForeignObj    -> [Char]
-       unpackNBytesFO,    -- :: ForeignObj    -> Int  -> [Char]
-       unpackCStringFO#,  -- :: ForeignObj#   -> [Char]
-       unpackNBytesFO#    -- :: ForeignObj#   -> Int# -> [Char]
-#endif
+       StateAndForeignObj#(..)
    ) where
 
 import PrelIOBase
@@ -39,19 +33,22 @@ import PrelGHC
 
 \begin{code}
 #ifndef __PARALLEL_HASKELL__
-instance CCallable ForeignObj
-instance CCallable ForeignObj#
+--instance CCallable ForeignObj
+--instance CCallable ForeignObj#
 
 eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
-makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
+--makeForeignObj  :: Addr        -> Addr       -> IO ForeignObj
 writeForeignObj :: ForeignObj  -> Addr       -> IO ()
 
 {- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
 makeMallocPtr   :: Addr        -> IO ForeignObj
 
+{-
+--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#))
+-}
 
 writeForeignObj (ForeignObj fo#) (A# datum#) = IO ( \ s# ->
     case writeForeignObj# fo# datum# s# of { s1# -> IOok s1# () } )
@@ -101,6 +98,14 @@ deRefStablePtr (StablePtr sp#) = IO $ \ rw1# ->
 
 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}
 
@@ -114,48 +119,5 @@ freeStablePtr sp = _ccall_ freeStablePointer sp
 #ifndef __PARALLEL_HASKELL__
 data StateAndStablePtr# s a = StateAndStablePtr# (State# s) (StablePtr# a)
 #endif
-data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
-\end{code}
-
-%*********************************************************
-%*                                                     *
-\subsection{Unpacking Foreigns}
-%*                                                     *
-%*********************************************************
-
-Primitives for converting Foreigns pointing to external
-sequence of bytes into a list of @Char@s (a renamed version
-of the code above).
-
-\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
+--data StateAndForeignObj# s  = StateAndForeignObj# (State# s) ForeignObj#
 \end{code}
-
-