Foreign/Storable.lhs

   1 \begin{code}
   2 {-# OPTIONS -fno-implicit-prelude #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  Foreign.Storable
   6 -- Copyright   :  (c) The FFI task force 2001
   7 -- License     :  see libraries/base/LICENSE
   8 --
   9 -- Maintainer  :  ffi@haskell.org
  10 -- Stability   :  provisional
  11 -- Portability :  portable
  12 --
  13 -- The module "Storable" provides most elementary support for
  14 -- marshalling and is part of the language-independent portion of the
  15 -- Foreign Function Interface (FFI), and will normally be imported via
  16 -- the "Foreign" module.
  17 --
  18 -----------------------------------------------------------------------------
  19
  20 module Foreign.Storable
  21         ( Storable(
  22              sizeOf,         -- :: a -> Int
  23              alignment,      -- :: a -> Int
  24              peekElemOff,    -- :: Ptr a -> Int      -> IO a
  25              pokeElemOff,    -- :: Ptr a -> Int -> a -> IO ()
  26              peekByteOff,    -- :: Ptr b -> Int      -> IO a
  27              pokeByteOff,    -- :: Ptr b -> Int -> a -> IO ()
  28              peek,           -- :: Ptr a             -> IO a
  29              poke)           -- :: Ptr a        -> a -> IO ()
  30         ) where
  31 \end{code}
  32
  33 \begin{code}
  34 import Control.Monad            ( liftM )
  35 import Foreign.Ptr
  36 import Foreign.C.Types
  37 import Foreign.C.TypesISO
  38
  39 #include "MachDeps.h"
  40
  41 #ifdef __GLASGOW_HASKELL__
  42 import GHC.Storable
  43 #elif defined(__HUGS__)
  44 import HugsStorable
  45 #endif
  46 \end{code}
  47
  48 Primitive marshaling
  49
  50 Minimal complete definition: sizeOf, alignment, and one definition
  51 in each of the peek/poke families.
  52
  53 \begin{code}
  54 {- |
  55 The member functions of this class facilitate writing values of
  56 primitive types to raw memory (which may have been allocated with the
  57 above mentioned routines) and reading values from blocks of raw
  58 memory.  The class, furthermore, includes support for computing the
  59 storage requirements and alignment restrictions of storable types.
  60
  61 Memory addresses are represented as values of type @'Ptr' a@, for some
  62 @a@ which is an instance of class 'Storable'.  The type argument to
  63 'Ptr' helps provide some valuable type safety in FFI code (you can\'t
  64 mix pointers of different types without an explicit cast), while
  65 helping the Haskell type system figure out which marshalling method is
  66 needed for a given pointer.
  67
  68 All marshalling between Haskell and a foreign language ultimately
  69 boils down to translating Haskell data structures into the binary
  70 representation of a corresponding data structure of the foreign
  71 language and vice versa.  To code this marshalling in Haskell, it is
  72 necessary to manipulate primtive data types stored in unstructured
  73 memory blocks.  The class 'Storable' facilitates this manipulation on
  74 all types for which it is instantiated, which are the standard basic
  75 types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
  76 'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
  77 'Word32', 'Word64'), 'StablePtr', all types from "CTypes" and
  78 "CTypesISO", as well as 'Ptr'.
  79
  80 Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
  81 'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
  82 'pokeByteOff'.
  83 -}
  84
  85 class Storable a where
  86
  87    sizeOf      :: a -> Int
  88    -- ^ Computes the storage requirements (in bytes) of the argument.
  89    -- The value of the argument is not used.
  90
  91    alignment   :: a -> Int
  92    -- ^ Computes the alignment constraint of the argument.  An
  93    -- alignment constraint @x@ is fulfilled by any address divisible
  94    -- by @x@.  The value of the argument is not used.
  95
  96    peekElemOff :: Ptr a -> Int      -> IO a
  97    -- ^       Read a value from a memory area regarded as an array
  98    --         of values of the same kind.  The first argument specifies
  99    --         the start address of the array and the second the index into
 100    --         the array (the first element of the array has index
 101    --         @0@).  The following equality holds,
 102    --
 103    -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
 104    -- >   peek (addr \`plusPtr\` (idx * sizeOf result))
 105    --
 106    --         Note that this is only a specification, not
 107    --         necessarily the concrete implementation of the
 108    --         function.
 109
 110    pokeElemOff :: Ptr a -> Int -> a -> IO ()
 111    -- ^       Write a value to a memory area regarded as an array of
 112    --         values of the same kind.  The following equality holds:
 113    --
 114    -- > pokeElemOff addr idx x =
 115    -- >   poke (addr \`plusPtr\` (idx * sizeOf x)) x
 116
 117    peekByteOff :: Ptr b -> Int      -> IO a
 118    -- ^       Read a value from a memory location given by a base
 119    --         address and offset.  The following equality holds:
 120    --
 121    -- > peekByteOff addr off = peek (addr \`plusPtr\` off)
 122
 123    pokeByteOff :: Ptr b -> Int -> a -> IO ()
 124    -- ^       Write a value to a memory location given by a base
 125    --         address and offset.  The following equality holds:
 126    --
 127    -- > pokeByteOff addr off x = poke (addr \`plusPtr\` off) x
 128
 129    peek        :: Ptr a      -> IO a
 130    -- ^ Read a value from the given memory location.
 131    --
 132    --  Note that the peek and poke functions might require properly
 133    --  aligned addresses to function correctly.  This is architecture
 134    --  dependent; thus, portable code should ensure that when peeking or
 135    --  poking values of some type @a@, the alignment
 136    --  constraint for @a@, as given by the function
 137    --  'alignment' is fulfilled.
 138
 139    poke        :: Ptr a -> a -> IO ()
 140    -- ^ Write the given value to the given memory location.  Alignment
 141    -- restrictions might apply; see 'peek'.
 142
 143    -- circular default instances
 144 #ifdef __GLASGOW_HASKELL__
 145    peekElemOff = peekElemOff_ undefined
 146       where peekElemOff_ :: a -> Ptr a -> Int -> IO a
 147             peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
 148 #else
 149    peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)
 150 #endif
 151    pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
 152
 153    peekByteOff ptr off = peek (ptr `plusPtr` off)
 154    pokeByteOff ptr off = poke (ptr `plusPtr` off)
 155
 156    peek ptr = peekElemOff ptr 0
 157    poke ptr = pokeElemOff ptr 0
 158 \end{code}
 159
 160 #ifndef __GLASGOW_HASKELL__
 161 \begin{code}
 162 sizeOfPtr :: Storable a => Ptr a -> a -> Int
 163 sizeOfPtr px x = sizeOf x
 164 \end{code}
 165 #endif
 166
 167 System-dependent, but rather obvious instances
 168
 169 \begin{code}
 170 instance Storable Bool where
 171    sizeOf _          = sizeOf (undefined::CInt)
 172    alignment _       = alignment (undefined::CInt)
 173    peekElemOff p i   = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i
 174    pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt)
 175
 176 #define STORABLE(T,size,align,read,write)       \
 177 instance Storable (T) where {                   \
 178     sizeOf    _ = size;                         \
 179     alignment _ = align;                        \
 180     peekElemOff = read;                         \
 181     pokeElemOff = write }
 182
 183 #ifdef __GLASGOW_HASKELL__
 184 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
 185          readWideCharOffPtr,writeWideCharOffPtr)
 186 #elif defined(__HUGS__)
 187 STORABLE(Char,SIZEOF_CHAR,ALIGNMENT_HSCHAR,
 188          readCharOffPtr,writeCharOffPtr)
 189 #endif
 190
 191 STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
 192          readIntOffPtr,writeIntOffPtr)
 193
 194 #ifdef __GLASGOW_HASKELL__
 195 STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
 196          readWordOffPtr,writeWordOffPtr)
 197 #endif
 198
 199 STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
 200          readPtrOffPtr,writePtrOffPtr)
 201
 202 STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
 203          readFunPtrOffPtr,writeFunPtrOffPtr)
 204
 205 STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
 206          readStablePtrOffPtr,writeStablePtrOffPtr)
 207
 208 STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
 209          readFloatOffPtr,writeFloatOffPtr)
 210
 211 STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
 212          readDoubleOffPtr,writeDoubleOffPtr)
 213
 214 STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
 215          readWord8OffPtr,writeWord8OffPtr)
 216
 217 STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
 218          readWord16OffPtr,writeWord16OffPtr)
 219
 220 STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
 221          readWord32OffPtr,writeWord32OffPtr)
 222
 223 STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
 224          readWord64OffPtr,writeWord64OffPtr)
 225
 226 STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
 227          readInt8OffPtr,writeInt8OffPtr)
 228
 229 STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
 230          readInt16OffPtr,writeInt16OffPtr)
 231
 232 STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
 233          readInt32OffPtr,writeInt32OffPtr)
 234
 235 STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
 236          readInt64OffPtr,writeInt64OffPtr)
 237
 238 #define NSTORABLE(T) \
 239 instance Storable T where { \
 240    sizeOf    (T x)       = sizeOf x ; \
 241    alignment (T x)       = alignment x ; \
 242    peekElemOff a i       = liftM T (peekElemOff (castPtr a) i) ; \
 243    pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
 244
 245 NSTORABLE(CChar)
 246 NSTORABLE(CSChar)
 247 NSTORABLE(CUChar)
 248 NSTORABLE(CShort)
 249 NSTORABLE(CUShort)
 250 NSTORABLE(CInt)
 251 NSTORABLE(CUInt)
 252 NSTORABLE(CLong)
 253 NSTORABLE(CULong)
 254 #ifndef __HUGS__
 255 NSTORABLE(CLLong)
 256 NSTORABLE(CULLong)
 257 #endif
 258 NSTORABLE(CFloat)
 259 NSTORABLE(CDouble)
 260 NSTORABLE(CLDouble)
 261 NSTORABLE(CPtrdiff)
 262 NSTORABLE(CSize)
 263 NSTORABLE(CWchar)
 264 NSTORABLE(CSigAtomic)
 265 NSTORABLE(CClock)
 266 NSTORABLE(CTime)
 267 \end{code}