[project @ 1997-10-08 17:42:31 by sof]

[ghc-hetmet.git] / ghc / lib / glaExts / Foreign.lhs

diff --git a/ghc/lib/glaExts/Foreign.lhs b/ghc/lib/glaExts/Foreign.lhs
index 88b200b..4285e78 100644 (file)
--- a/ghc/lib/glaExts/Foreign.lhs
+++ b/ghc/lib/glaExts/Foreign.lhs
@@ -9,11 +9,14 @@
 
 module Foreign (
        module Foreign,
-       Addr, Word
+#ifndef __PARALLEL_HASKELL__
+       ForeignObj(..),
+#endif
+       Addr(..), Word(..)
    ) where
 
 import STBase
-import ArrBase
+import UnsafeST        ( unsafePerformPrimIO )
 import PrelBase
 import GHC
 \end{code}
@@ -48,21 +51,18 @@ instance CCallable   Double
 instance CCallable   Double#
 instance CReturnable Double
 
+data Addr = A# Addr#   deriving (Eq, Ord) -- Glasgow extension
+
 instance CCallable Addr
 instance CCallable Addr#
 instance CReturnable Addr
 
+data Word = W# Word#   deriving (Eq, Ord) -- Glasgow extension
+
 instance CCallable Word
 instance CCallable Word#
 instance CReturnable Word
 
--- Is this right?
-instance CCallable (MutableByteArray s ix)
-instance CCallable (MutableByteArray# s)
-
-instance CCallable (ByteArray ix)
-instance CCallable ByteArray#
-
 instance CReturnable () -- Why, exactly?
 \end{code}
 
@@ -74,16 +74,28 @@ instance CReturnable () -- Why, exactly?
 %*********************************************************
 
 \begin{code}
-data ForeignObj = ForeignObj ForeignObj#
+#ifndef __PARALLEL_HASKELL__
+--Defined in PrelBase: data ForeignObj = ForeignObj ForeignObj#
+data ForeignObj = ForeignObj ForeignObj#   -- another one
+
 instance CCallable ForeignObj
 instance CCallable ForeignObj#
 
-eqForeignObj   :: ForeignObj -> ForeignObj -> Bool
-makeForeignObj :: Addr       -> Addr       -> PrimIO ForeignObj
+eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
+makeForeignObj  :: Addr        -> Addr       -> PrimIO ForeignObj
+writeForeignObj :: ForeignObj  -> Addr       -> PrimIO ()
+
+{- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
+makeMallocPtr   :: Addr        -> PrimIO ForeignObj
 
-makeForeignObj (A# obj) (A# finaliser) = ST $ \ (S# s#) ->
+makeForeignObj (A# obj) (A# finaliser) = ST ( \ (S# s#) ->
     case makeForeignObj# obj finaliser s# of
-      StateAndForeignObj# s1# fo# -> (ForeignObj fo#, S# s1#)
+      StateAndForeignObj# s1# fo# -> (ForeignObj fo#, S# s1#))
+
+writeForeignObj (ForeignObj fo#) (A# datum#) = ST ( \ (S# s#) ->
+    case writeForeignObj# fo# datum# s# of { s1# -> ((), S# s1#) } )
+
+makeMallocPtr a = makeForeignObj a (``&free''::Addr)
 
 eqForeignObj mp1 mp2
   = unsafePerformPrimIO (_ccall_ eqForeignObj mp1 mp2) /= (0::Int)
@@ -91,6 +103,7 @@ eqForeignObj mp1 mp2
 instance Eq ForeignObj where 
     p == q = eqForeignObj p q
     p /= q = not (eqForeignObj p q)
+#endif /* !__PARALLEL_HASKELL__ */
 \end{code}