X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelForeign.lhs;h=d99ca15b49ca67f14d394d03bc287e0748bbb2f1;hb=ce6e38dc12b5feae2eb43e94d833646a9c921cda;hp=7a5c6d27a1665ffc21cfcda4944734aa95ec26b9;hpb=28139aea50376444d56f43f0914291348a51a7e7;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs
index 7a5c6d2..d99ca15 100644
--- a/ghc/lib/std/PrelForeign.lhs
+++ b/ghc/lib/std/PrelForeign.lhs
@@ -1,5 +1,7 @@
+% ------------------------------------------------------------------------------
+% $Id: PrelForeign.lhs,v 1.15 2000/06/30 13:39:35 simonmar Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
 
 \section[Foreign]{Module @Foreign@}
@@ -11,24 +13,17 @@ module PrelForeign (
 	module PrelForeign,
 #ifndef __PARALLEL_HASKELL__
 	ForeignObj(..),
-#endif
-	Word(..),
-
-#ifndef __PARALLEL_HASKELL__
-	unpackCStringFO,   -- :: ForeignObj    -> [Char]
-	unpackNBytesFO,    -- :: ForeignObj    -> Int  -> [Char]
-	unpackCStringFO#,  -- :: ForeignObj#   -> [Char]
-	unpackNBytesFO#    -- :: ForeignObj#   -> Int# -> [Char]
+	makeForeignObj,
+	-- SUP: deprecated
+	mkForeignObj,
+	writeForeignObj
 #endif
    ) where
 
 import PrelIOBase
-import PrelST
-import PrelUnsafe
 import PrelBase
-import PrelCCall
 import PrelAddr
-import PrelGHC
+import PrelWeak	( addForeignFinalizer )
 \end{code}
 
 
@@ -38,88 +33,33 @@ import PrelGHC
 %*							*
 %*********************************************************
 
-\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
-
-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# () } )
-
-makeMallocPtr a = makeForeignObj a (``&free''::Addr)
-
-eqForeignObj mp1 mp2
-  = unsafePerformIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
-
-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}
-%*							*
-%*********************************************************
+mkForeignObj and writeForeignObj are the building blocks
+for makeForeignObj, they can probably be nuked in the future.
 
 \begin{code}
 #ifndef __PARALLEL_HASKELL__
-data StablePtr a = StablePtr (StablePtr# a)
-instance CCallable   (StablePtr a)
-instance CCallable   (StablePtr# a)
-instance CReturnable (StablePtr a)
-
--- 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.
-
-makeStablePtr  :: a -> IO (StablePtr a)
-deRefStablePtr :: StablePtr a -> IO a
-freeStablePtr  :: StablePtr a -> IO ()
-
-{-# INLINE deRefStablePtr #-}
-{-# INLINE freeStablePtr #-}
-
-makeStablePtr f = IO $ \ rw1# ->
-    case makeStablePtr# f rw1# of
-      StateAndStablePtr# rw2# sp# -> IOok rw2# (StablePtr sp#)
+--instance CCallable ForeignObj
+--instance CCallable ForeignObj#
 
-deRefStablePtr (StablePtr sp#) = IO $ \ rw1# ->
-    case deRefStablePtr# sp# rw1# of
-      StateAndPtr# rw2# a -> IOok rw2# a
+makeForeignObj :: Addr -> IO () -> IO ForeignObj
+makeForeignObj addr finalizer = do
+   fObj <- mkForeignObj addr
+   addForeignFinalizer fObj finalizer
+   return fObj
 
-freeStablePtr sp = _ccall_ freeStablePointer sp
+mkForeignObj  :: Addr -> IO ForeignObj
+mkForeignObj (A# obj) = IO ( \ s# ->
+    case mkForeignObj# obj s# of
+      (# s1#, fo# #) -> (# s1#,  ForeignObj 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}
 
 %*********************************************************
 %*							*
-\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}
-
-%*********************************************************
-%*							*
 \subsection{Unpacking Foreigns}
 %*							*
 %*********************************************************
@@ -158,5 +98,3 @@ unpackNBytesFO# fo len
 	ch = indexCharOffForeignObj# fo i
 #endif
 \end{code}
-
-