GHC/Storable.lhs

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