% -----------------------------------------------------------------------------
-% $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
%
A class for primitive marshaling
\begin{code}
+{-# OPTIONS -fno-implicit-prelude #-}
+
#include "MachDeps.h"
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
import PrelStable
import PrelPtr
import PrelFloat
+import PrelErr
import PrelIOBase
import PrelBase
#endif
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
peek ptr = peekElemOff ptr 0
poke ptr = pokeElemOff ptr 0
+
+ destruct _ = return ()
\end{code}
System-dependent, but rather obvious instances
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; \
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)
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)
= 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)
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 ()
= 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)