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