Foreign/Storable.hs

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