Foreign/Storable.hs

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