[project @ 1997-03-17 20:34:25 by simonpj]

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

diff --git a/ghc/lib/glaExts/Foreign.lhs b/ghc/lib/glaExts/Foreign.lhs
index 0b6aea8..81abc4f 100644 (file)
--- a/ghc/lib/glaExts/Foreign.lhs
+++ b/ghc/lib/glaExts/Foreign.lhs
@@ -5,12 +5,14 @@
 \section[Foreign]{Module @Foreign@}
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
 module Foreign (
        module Foreign,
+       ForeignObj(..),
        Addr, Word
    ) where
 
-import Prelude ()
 import STBase
 import ArrBase
 import PrelBase
@@ -29,30 +31,38 @@ class CCallable   a
 class CReturnable a
 
 instance CCallable Char
+instance CCallable   Char#
 instance CReturnable Char
 
 instance CCallable   Int
+instance CCallable   Int#
 instance CReturnable Int
 
 -- DsCCall knows how to pass strings...
 instance CCallable   [Char]
 
 instance CCallable   Float
+instance CCallable   Float#
 instance CReturnable Float
 
 instance CCallable   Double
+instance CCallable   Double#
 instance CReturnable Double
 
 instance CCallable Addr
+instance CCallable Addr#
 instance CReturnable Addr
 
 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}
@@ -65,15 +75,25 @@ instance CReturnable () -- Why, exactly?
 %*********************************************************
 
 \begin{code}
-data ForeignObj = ForeignObj ForeignObj#
+--Defined in PrelBase: data ForeignObj = ForeignObj ForeignObj#
 instance CCallable ForeignObj
+instance CCallable ForeignObj#
+
+eqForeignObj    :: ForeignObj  -> ForeignObj -> Bool
+makeForeignObj  :: Addr        -> Addr       -> PrimIO ForeignObj
+writeForeignObj :: ForeignObj  -> Addr       -> PrimIO ()
 
-eqForeignObj   :: ForeignObj -> ForeignObj -> Bool
-makeForeignObj :: Addr       -> Addr       -> PrimIO ForeignObj
+{- 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)
@@ -94,6 +114,7 @@ instance Eq ForeignObj where
 #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