[project @ 2001-08-04 06:11:24 by ken]

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

diff --git a/ghc/lib/std/PrelMarshalUtils.lhs b/ghc/lib/std/PrelMarshalUtils.lhs
index 3ca37dc..fd31573 100644 (file)
--- a/ghc/lib/std/PrelMarshalUtils.lhs
+++ b/ghc/lib/std/PrelMarshalUtils.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelMarshalUtils.lhs,v 1.1 2001/01/11 17:25:57 simonmar Exp $
+% $Id: PrelMarshalUtils.lhs,v 1.3 2001/05/18 16:54:05 simonmar Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -7,6 +7,8 @@
 Utilities for primitive marshaling
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
 module PrelMarshalUtils (
 
   -- combined allocation and marshalling
@@ -40,13 +42,17 @@ module PrelMarshalUtils (
   moveBytes      -- :: Ptr a -> Ptr a -> Int -> IO ()
 ) where
 
-import Monad           ( liftM )
-
+#ifdef __GLASGOW_HASKELL__
 import PrelPtr         ( Ptr, nullPtr )
-import PrelStorable    ( Storable (poke) )
+import PrelStorable    ( Storable(poke,destruct) )
 import PrelCTypesISO    ( CSize )
 import PrelMarshalAlloc ( malloc, alloca )
-
+import PrelIOBase
+import PrelMaybe
+import PrelReal                ( fromIntegral )
+import PrelNum
+import PrelBase
+#endif
 
 -- combined allocation and marshalling
 -- -----------------------------------
@@ -66,7 +72,12 @@ new val  =
 --
 {- FIXME: should be called `with' -}
 withObject       :: Storable a => a -> (Ptr a -> IO b) -> IO b
-withObject val f  = alloca $ \ptr -> do poke ptr val; f ptr
+withObject val f  =
+  alloca $ \ptr -> do
+    poke ptr val
+    res <- f ptr
+    destruct ptr
+    return res
 
 
 -- marshalling of Boolean values (non-zero corresponds to `True')
@@ -107,7 +118,7 @@ maybeWith  = maybe ($ nullPtr)
 --
 maybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
 maybePeek peek ptr | ptr == nullPtr  = return Nothing
-                  | otherwise       = liftM Just $ peek ptr
+                  | otherwise       = do a <- peek ptr; return (Just a)
 
 
 -- marshalling lists of storable objects