ghc/lib/std/PrelStorable.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelStorable.lhs,v 1.12 2002/02/05 16:56:39 sewardj Exp $
   3 %
   4 % (c) The FFI task force, 2000
   5 %
   6
   7 A class for primitive marshaling
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 #include "MachDeps.h"
  13
  14 module PrelStorable
  15         ( Storable(
  16              sizeOf,         -- :: a -> Int
  17              alignment,      -- :: a -> Int
  18              peekElemOff,    -- :: Ptr a -> Int      -> IO a
  19              pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()
  20              peekByteOff,    -- :: Ptr b -> Int      -> IO a
  21              pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
  22              peek,           -- :: Ptr a             -> IO a
  23              poke,           -- :: Ptr a        -> a -> IO ()
  24
  25              -- DEPRECATED: Don't use!
  26              destruct)       -- :: Ptr a             -> IO ()
  27         ) where
  28 \end{code}
  29
  30 \begin{code}
  31 import Monad            ( liftM )
  32
  33 #ifdef __GLASGOW_HASKELL__
  34 import PrelStable       ( StablePtr )
  35 import PrelNum
  36 import PrelInt
  37 import PrelWord
  38 import PrelCTypes
  39 import PrelCTypesISO
  40 import PrelStable
  41 import PrelPtr
  42 import PrelFloat
  43 import PrelErr
  44 import PrelIOBase
  45 import PrelBase
  46 #endif
  47 \end{code}
  48
  49 Primitive marshaling
  50
  51 Minimal complete definition: sizeOf, alignment, and one definition
  52 in each of the peek/poke families.
  53
  54 \begin{code}
  55 class Storable a where
  56
  57    -- sizeOf/alignment *never* use their first argument
  58    sizeOf      :: a -> Int
  59    alignment   :: a -> Int
  60
  61    -- replacement for read-/write???OffAddr
  62    peekElemOff :: Ptr a -> Int      -> IO a
  63    pokeElemOff :: Ptr a -> Int -> a -> IO ()
  64
  65    -- the same with *byte* offsets
  66    peekByteOff :: Ptr b -> Int      -> IO a
  67    pokeByteOff :: Ptr b -> Int -> a -> IO ()
  68
  69    -- ... and with no offsets at all
  70    peek        :: Ptr a      -> IO a
  71    poke        :: Ptr a -> a -> IO ()
  72
  73    -- free memory associated with the object
  74    -- (except the object pointer itself)
  75    destruct    :: Ptr a -> IO ()
  76
  77    -- circular default instances
  78    peekElemOff = peekElemOff_ undefined
  79       where peekElemOff_ :: a -> Ptr a -> Int -> IO a
  80             peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
  81    pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
  82
  83    peekByteOff ptr off = peek (ptr `plusPtr` off)
  84    pokeByteOff ptr off = poke (ptr `plusPtr` off)
  85
  86    peek ptr = peekElemOff ptr 0
  87    poke ptr = pokeElemOff ptr 0
  88
  89    destruct _ = return ()
  90 {-# DEPRECATED destruct "This function is not standards compliant" #-}
  91 \end{code}
  92
  93 System-dependent, but rather obvious instances
  94
  95 \begin{code}
  96 instance Storable Bool where
  97    sizeOf _          = sizeOf (undefined::CInt)
  98    alignment _       = alignment (undefined::CInt)
  99    peekElemOff p i   = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
 100    pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
 101
 102 #define STORABLE(T,size,align,read,write)       \
 103 instance Storable (T) where {                   \
 104     sizeOf    _ = size;                         \
 105     alignment _ = align;                        \
 106     peekElemOff = read;                         \
 107     pokeElemOff = write }
 108
 109 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
 110          readWideCharOffPtr,writeWideCharOffPtr)
 111
 112 STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
 113          readIntOffPtr,writeIntOffPtr)
 114
 115 STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
 116          readWordOffPtr,writeWordOffPtr)
 117
 118 STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
 119          readPtrOffPtr,writePtrOffPtr)
 120
 121 STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
 122          readFunPtrOffPtr,writeFunPtrOffPtr)
 123
 124 STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
 125          readStablePtrOffPtr,writeStablePtrOffPtr)
 126
 127 STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
 128          readFloatOffPtr,writeFloatOffPtr)
 129
 130 STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
 131          readDoubleOffPtr,writeDoubleOffPtr)
 132
 133 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
 134          readWord8OffPtr,writeWord8OffPtr)
 135
 136 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
 137          readWord16OffPtr,writeWord16OffPtr)
 138
 139 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
 140          readWord32OffPtr,writeWord32OffPtr)
 141
 142 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
 143          readWord64OffPtr,writeWord64OffPtr)
 144
 145 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
 146          readInt8OffPtr,writeInt8OffPtr)
 147
 148 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
 149          readInt16OffPtr,writeInt16OffPtr)
 150
 151 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
 152          readInt32OffPtr,writeInt32OffPtr)
 153
 154 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
 155          readInt64OffPtr,writeInt64OffPtr)
 156
 157 #define NSTORABLE(T) \
 158 instance Storable T where { \
 159    sizeOf    (T x)       = sizeOf x ; \
 160    alignment (T x)       = alignment x ; \
 161    peekElemOff a i       = liftM T (peekElemOff (castPtr a) i) ; \
 162    pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
 163
 164 NSTORABLE(CChar)
 165 NSTORABLE(CSChar)
 166 NSTORABLE(CUChar)
 167 NSTORABLE(CShort)
 168 NSTORABLE(CUShort)
 169 NSTORABLE(CInt)
 170 NSTORABLE(CUInt)
 171 NSTORABLE(CLong)
 172 NSTORABLE(CULong)
 173 NSTORABLE(CLLong)
 174 NSTORABLE(CULLong)
 175 NSTORABLE(CFloat)
 176 NSTORABLE(CDouble)
 177 NSTORABLE(CLDouble)
 178 NSTORABLE(CPtrdiff)
 179 NSTORABLE(CSize)
 180 NSTORABLE(CWchar)
 181 NSTORABLE(CSigAtomic)
 182 NSTORABLE(CClock)
 183 NSTORABLE(CTime)
 184 \end{code}
 185
 186 Helper functions
 187
 188 \begin{code}
 189 #ifdef __GLASGOW_HASKELL__
 190
 191 readWideCharOffPtr  :: Ptr Char          -> Int -> IO Char
 192 readIntOffPtr       :: Ptr Int           -> Int -> IO Int
 193 readWordOffPtr      :: Ptr Word          -> Int -> IO Word
 194 readPtrOffPtr       :: Ptr (Ptr a)       -> Int -> IO (Ptr a)
 195 readFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> IO (FunPtr a)
 196 readFloatOffPtr     :: Ptr Float         -> Int -> IO Float
 197 readDoubleOffPtr    :: Ptr Double        -> Int -> IO Double
 198 readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
 199 readInt8OffPtr      :: Ptr Int8          -> Int -> IO Int8
 200 readInt16OffPtr     :: Ptr Int16         -> Int -> IO Int16
 201 readInt32OffPtr     :: Ptr Int32         -> Int -> IO Int32
 202 readInt64OffPtr     :: Ptr Int64         -> Int -> IO Int64
 203 readWord8OffPtr     :: Ptr Word8         -> Int -> IO Word8
 204 readWord16OffPtr    :: Ptr Word16        -> Int -> IO Word16
 205 readWord32OffPtr    :: Ptr Word32        -> Int -> IO Word32
 206 readWord64OffPtr    :: Ptr Word64        -> Int -> IO Word64
 207
 208 readWideCharOffPtr (Ptr a) (I# i)
 209   = IO $ \s -> case readWideCharOffAddr# a i s  of (# s2, x #) -> (# s2, C# x #)
 210 readIntOffPtr (Ptr a) (I# i)
 211   = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I# x #)
 212 readWordOffPtr (Ptr a) (I# i)
 213   = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W# x #)
 214 readPtrOffPtr (Ptr a) (I# i)
 215   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, Ptr x #)
 216 readFunPtrOffPtr (Ptr a) (I# i)
 217   = IO $ \s -> case readAddrOffAddr# a i s      of (# s2, x #) -> (# s2, FunPtr x #)
 218 readFloatOffPtr (Ptr a) (I# i)
 219   = IO $ \s -> case readFloatOffAddr# a i s     of (# s2, x #) -> (# s2, F# x #)
 220 readDoubleOffPtr (Ptr a) (I# i)
 221   = IO $ \s -> case readDoubleOffAddr# a i s    of (# s2, x #) -> (# s2, D# x #)
 222 readStablePtrOffPtr (Ptr a) (I# i)
 223   = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
 224 readInt8OffPtr (Ptr a) (I# i)
 225   = IO $ \s -> case readInt8OffAddr# a i s      of (# s2, x #) -> (# s2, I8# x #)
 226 readWord8OffPtr (Ptr a) (I# i)
 227   = IO $ \s -> case readWord8OffAddr# a i s     of (# s2, x #) -> (# s2, W8# x #)
 228 readInt16OffPtr (Ptr a) (I# i)
 229   = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
 230 readWord16OffPtr (Ptr a) (I# i)
 231   = IO $ \s -> case readWord16OffAddr# a i s    of (# s2, x #) -> (# s2, W16# x #)
 232 readInt32OffPtr (Ptr a) (I# i)
 233   = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
 234 readWord32OffPtr (Ptr a) (I# i)
 235   = IO $ \s -> case readWord32OffAddr# a i s    of (# s2, x #) -> (# s2, W32# x #)
 236 readInt64OffPtr (Ptr a) (I# i)
 237   = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
 238 readWord64OffPtr (Ptr a) (I# i)
 239   = IO $ \s -> case readWord64OffAddr# a i s    of (# s2, x #) -> (# s2, W64# x #)
 240
 241 writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
 242 writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
 243 writeWordOffPtr      :: Ptr Word          -> Int -> Word        -> IO ()
 244 writePtrOffPtr       :: Ptr (Ptr a)       -> Int -> Ptr a       -> IO ()
 245 writeFunPtrOffPtr    :: Ptr (FunPtr a)    -> Int -> FunPtr a    -> IO ()
 246 writeFloatOffPtr     :: Ptr Float         -> Int -> Float       -> IO ()
 247 writeDoubleOffPtr    :: Ptr Double        -> Int -> Double      -> IO ()
 248 writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
 249 writeInt8OffPtr      :: Ptr Int8          -> Int -> Int8        -> IO ()
 250 writeInt16OffPtr     :: Ptr Int16         -> Int -> Int16       -> IO ()
 251 writeInt32OffPtr     :: Ptr Int32         -> Int -> Int32       -> IO ()
 252 writeInt64OffPtr     :: Ptr Int64         -> Int -> Int64       -> IO ()
 253 writeWord8OffPtr     :: Ptr Word8         -> Int -> Word8       -> IO ()
 254 writeWord16OffPtr    :: Ptr Word16        -> Int -> Word16      -> IO ()
 255 writeWord32OffPtr    :: Ptr Word32        -> Int -> Word32      -> IO ()
 256 writeWord64OffPtr    :: Ptr Word64        -> Int -> Word64      -> IO ()
 257
 258 writeWideCharOffPtr (Ptr a) (I# i) (C# x)
 259   = IO $ \s -> case writeWideCharOffAddr# a i x s  of s2 -> (# s2, () #)
 260 writeIntOffPtr (Ptr a) (I# i) (I# x)
 261   = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
 262 writeWordOffPtr (Ptr a) (I# i) (W# x)
 263   = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
 264 writePtrOffPtr (Ptr a) (I# i) (Ptr x)
 265   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
 266 writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x)
 267   = IO $ \s -> case writeAddrOffAddr# a i x s      of s2 -> (# s2, () #)
 268 writeFloatOffPtr (Ptr a) (I# i) (F# x)
 269   = IO $ \s -> case writeFloatOffAddr# a i x s     of s2 -> (# s2, () #)
 270 writeDoubleOffPtr (Ptr a) (I# i) (D# x)
 271   = IO $ \s -> case writeDoubleOffAddr# a i x s    of s2 -> (# s2, () #)
 272 writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
 273   = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
 274 writeInt8OffPtr (Ptr a) (I# i) (I8# x)
 275   = IO $ \s -> case writeInt8OffAddr# a i x s      of s2 -> (# s2, () #)
 276 writeWord8OffPtr (Ptr a) (I# i) (W8# x)
 277   = IO $ \s -> case writeWord8OffAddr# a i x s     of s2 -> (# s2, () #)
 278 writeInt16OffPtr (Ptr a) (I# i) (I16# x)
 279   = IO $ \s -> case writeInt16OffAddr# a i x s     of s2 -> (# s2, () #)
 280 writeWord16OffPtr (Ptr a) (I# i) (W16# x)
 281   = IO $ \s -> case writeWord16OffAddr# a i x s    of s2 -> (# s2, () #)
 282 writeInt32OffPtr (Ptr a) (I# i) (I32# x)
 283   = IO $ \s -> case writeInt32OffAddr# a i x s     of s2 -> (# s2, () #)
 284 writeWord32OffPtr (Ptr a) (I# i) (W32# x)
 285   = IO $ \s -> case writeWord32OffAddr# a i x s    of s2 -> (# s2, () #)
 286 writeInt64OffPtr (Ptr a) (I# i) (I64# x)
 287   = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
 288 writeWord64OffPtr (Ptr a) (I# i) (W64# x)
 289   = IO $ \s -> case writeWord64OffAddr# a i x s    of s2 -> (# s2, () #)
 290
 291 #endif /* __GLASGOW_HASKELL__ */
 292 \end{code}