X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2FglaExts%2FForeign.lhs;h=81abc4f13dc0857458e42a432491d27e05591f16;hb=2494407a750053daa61718fac371487d04818e57;hp=8273434390e9fc04f6bd09ef8ee78abf6a8b2887;hpb=27c1aa882a537f27417bd14a27c7dac4be0ddbc3;p=ghc-hetmet.git

diff --git a/ghc/lib/glaExts/Foreign.lhs b/ghc/lib/glaExts/Foreign.lhs
index 8273434..81abc4f 100644
--- a/ghc/lib/glaExts/Foreign.lhs
+++ b/ghc/lib/glaExts/Foreign.lhs
@@ -79,12 +79,21 @@ instance CReturnable () -- Why, exactly?
 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 ()
 
-makeForeignObj (A# obj) (A# finaliser) = ST $ \ (S# s#) ->
+{- derived op - attaching a free() finaliser to a malloc() allocated reference. -}
+makeMallocPtr   :: Addr        -> PrimIO ForeignObj
+
+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)