X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelStorable.lhs;h=462fcf28e0a4dece2c0099209f99abf3fea87365;hb=f7c5bff1799f69a1505da0d643fa79ad0d37f393;hp=f02b83240159c321ae5d047b15919a7f04d19629;hpb=871db587eda4fcba3fdc049b225a1d63a4ebe641;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelStorable.lhs b/ghc/lib/std/PrelStorable.lhs
index f02b832..462fcf2 100644
--- a/ghc/lib/std/PrelStorable.lhs
+++ b/ghc/lib/std/PrelStorable.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelStorable.lhs,v 1.3 2001/02/28 00:01:03 qrczak Exp $
+% $Id: PrelStorable.lhs,v 1.7 2001/05/18 16:54:05 simonmar Exp $
 %
 % (c) The FFI task force, 2000
 %
@@ -7,6 +7,8 @@
 A class for primitive marshaling
 
 \begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
 #include "MachDeps.h"
 
 module PrelStorable
@@ -18,16 +20,17 @@ module PrelStorable
 	     peekByteOff,    -- :: Ptr b -> Int      -> IO a
 	     pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
 	     peek,           -- :: Ptr a             -> IO a
-	     poke)           -- :: Ptr a        -> a -> IO ()
+	     poke,           -- :: Ptr a        -> a -> IO ()
+	     destruct)       -- :: Ptr a             -> IO ()
         ) where
 \end{code}
 
 \begin{code}
-import Char		( chr, ord )
 import Monad		( liftM )
 
 #ifdef __GLASGOW_HASKELL__
 import PrelStable	( StablePtr )
+import PrelNum
 import PrelInt
 import PrelWord
 import PrelCTypes
@@ -35,6 +38,7 @@ import PrelCTypesISO
 import PrelStable
 import PrelPtr
 import PrelFloat
+import PrelErr
 import PrelIOBase
 import PrelBase
 #endif
@@ -64,6 +68,10 @@ class Storable a where
    peek        :: Ptr a      -> IO a
    poke        :: Ptr a -> a -> IO ()
 
+   -- free memory associated with the object
+   -- (except the object pointer itself)
+   destruct    :: Ptr a -> IO ()
+
    -- circular default instances
    peekElemOff = peekElemOff_ undefined
       where peekElemOff_ :: a -> Ptr a -> Int -> IO a
@@ -75,6 +83,8 @@ class Storable a where
 
    peek ptr = peekElemOff ptr 0
    poke ptr = pokeElemOff ptr 0
+
+   destruct _ = return ()
 \end{code}
 
 System-dependent, but rather obvious instances
@@ -86,12 +96,6 @@ instance Storable Bool where
    peekElemOff p i   = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
    pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
 
-instance Storable (FunPtr a) where
-   sizeOf          (FunPtr x) = sizeOf x
-   alignment       (FunPtr x) = alignment x
-   peekElemOff p i            = liftM FunPtr $ peekElemOff (castPtr p) i
-   pokeElemOff p i (FunPtr x) = pokeElemOff (castPtr p) i x
-
 #define STORABLE(T,size,align,read,write)	\
 instance Storable (T) where {			\
     sizeOf    _ = size;				\
@@ -111,6 +115,9 @@ STORABLE(Word,SIZEOF_LONG,ALIGNMENT_LONG,
 STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
 	 readPtrOffPtr,writePtrOffPtr)
 
+STORABLE((FunPtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
+	 readFunPtrOffPtr,writeFunPtrOffPtr)
+
 STORABLE((StablePtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
 	 readStablePtrOffPtr,writeStablePtrOffPtr)
 
@@ -182,6 +189,7 @@ readWideCharOffPtr  :: Ptr Char          -> Int -> IO Char
 readIntOffPtr       :: Ptr Int           -> Int -> IO Int
 readWordOffPtr      :: Ptr Word          -> Int -> IO Word
 readPtrOffPtr       :: Ptr (Ptr a)       -> Int -> IO (Ptr a)
+readFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> IO (FunPtr a)
 readFloatOffPtr     :: Ptr Float         -> Int -> IO Float
 readDoubleOffPtr    :: Ptr Double        -> Int -> IO Double
 readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
@@ -202,6 +210,8 @@ readWordOffPtr (Ptr a) (I# i)
   = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W# x #)
 readPtrOffPtr (Ptr a) (I# i)
   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, Ptr x #)
+readFunPtrOffPtr (Ptr a) (I# i)
+  = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, FunPtr x #)
 readFloatOffPtr (Ptr a) (I# i)
   = IO $ \s -> case readFloatOffAddr# a i s     of (# s2, x #) -> (# s2, F# x #)
 readDoubleOffPtr (Ptr a) (I# i)
@@ -229,6 +239,7 @@ writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
 writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
 writeWordOffPtr      :: Ptr Word          -> Int -> Word        -> IO ()
 writePtrOffPtr       :: Ptr (Ptr a)       -> Int -> Ptr a       -> IO ()
+writeFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> FunPtr a    -> IO ()
 writeFloatOffPtr     :: Ptr Float         -> Int -> Float       -> IO ()
 writeDoubleOffPtr    :: Ptr Double        -> Int -> Double      -> IO ()
 writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
@@ -249,6 +260,8 @@ writeWordOffPtr (Ptr a) (I# i) (W# x)
   = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
 writePtrOffPtr (Ptr a) (I# i) (Ptr x)
   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
+writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)
+  = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
 writeFloatOffPtr (Ptr a) (I# i) (F# x)
   = IO $ \s -> case writeFloatOffAddr# a i x s     of s2 -> (# s2, () #)
 writeDoubleOffPtr (Ptr a) (I# i) (D# x)