GHC/Storable.lhs

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