Foreign/Storable.hs

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