+++ /dev/null
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
------------------------------------------------------------------------------
--- |
--- Module : Foreign.Storable
--- Copyright : (c) The FFI task force 2001
--- License : see libraries/base/LICENSE
---
--- Maintainer : ffi@haskell.org
--- Stability : provisional
--- Portability : portable
---
--- The module "Foreign.Storable" provides most elementary support for
--- marshalling and is part of the language-independent portion of the
--- Foreign Function Interface (FFI), and will normally be imported via
--- the "Foreign" module.
---
------------------------------------------------------------------------------
-
-module Foreign.Storable
- ( Storable(
- sizeOf, -- :: a -> Int
- alignment, -- :: a -> Int
- peekElemOff, -- :: Ptr a -> Int -> IO a
- pokeElemOff, -- :: Ptr a -> Int -> a -> IO ()
- peekByteOff, -- :: Ptr b -> Int -> IO a
- pokeByteOff, -- :: Ptr b -> Int -> a -> IO ()
- peek, -- :: Ptr a -> IO a
- poke) -- :: Ptr a -> a -> IO ()
- ) where
-
-
-#ifdef __NHC__
-import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr
- ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)
-#else
-
-import Control.Monad ( liftM )
-
-#include "MachDeps.h"
-#include "HsBaseConfig.h"
-
-#ifdef __GLASGOW_HASKELL__
-import GHC.Storable
-import GHC.Stable ( StablePtr )
-import GHC.Num
-import GHC.Int
-import GHC.Word
-import GHC.Ptr
-import GHC.Float
-import GHC.Err
-import GHC.IOBase
-import GHC.Base
-#else
-import Data.Int
-import Data.Word
-import Foreign.StablePtr
-#endif
-
-#ifdef __HUGS__
-import Hugs.Prelude
-import Hugs.Ptr
-import Hugs.Storable
-#endif
-
-{- |
-The member functions of this class facilitate writing values of
-primitive types to raw memory (which may have been allocated with the
-above mentioned routines) and reading values from blocks of raw
-memory. The class, furthermore, includes support for computing the
-storage requirements and alignment restrictions of storable types.
-
-Memory addresses are represented as values of type @'Ptr' a@, for some
-@a@ which is an instance of class 'Storable'. The type argument to
-'Ptr' helps provide some valuable type safety in FFI code (you can\'t
-mix pointers of different types without an explicit cast), while
-helping the Haskell type system figure out which marshalling method is
-needed for a given pointer.
-
-All marshalling between Haskell and a foreign language ultimately
-boils down to translating Haskell data structures into the binary
-representation of a corresponding data structure of the foreign
-language and vice versa. To code this marshalling in Haskell, it is
-necessary to manipulate primitive data types stored in unstructured
-memory blocks. The class 'Storable' facilitates this manipulation on
-all types for which it is instantiated, which are the standard basic
-types of Haskell, the fixed size @Int@ types ('Int8', 'Int16',
-'Int32', 'Int64'), the fixed size @Word@ types ('Word8', 'Word16',
-'Word32', 'Word64'), 'StablePtr', all types from "Foreign.C.Types",
-as well as 'Ptr'.
-
-Minimal complete definition: 'sizeOf', 'alignment', one of 'peek',
-'peekElemOff' and 'peekByteOff', and one of 'poke', 'pokeElemOff' and
-'pokeByteOff'.
--}
-
-class Storable a where
-
- sizeOf :: a -> Int
- -- ^ Computes the storage requirements (in bytes) of the argument.
- -- The value of the argument is not used.
-
- alignment :: a -> Int
- -- ^ Computes the alignment constraint of the argument. An
- -- alignment constraint @x@ is fulfilled by any address divisible
- -- by @x@. The value of the argument is not used.
-
- peekElemOff :: Ptr a -> Int -> IO a
- -- ^ Read a value from a memory area regarded as an array
- -- of values of the same kind. The first argument specifies
- -- the start address of the array and the second the index into
- -- the array (the first element of the array has index
- -- @0@). The following equality holds,
- --
- -- > peekElemOff addr idx = IOExts.fixIO $ \result ->
- -- > peek (addr `plusPtr` (idx * sizeOf result))
- --
- -- Note that this is only a specification, not
- -- necessarily the concrete implementation of the
- -- function.
-
- pokeElemOff :: Ptr a -> Int -> a -> IO ()
- -- ^ Write a value to a memory area regarded as an array of
- -- values of the same kind. The following equality holds:
- --
- -- > pokeElemOff addr idx x =
- -- > poke (addr `plusPtr` (idx * sizeOf x)) x
-
- peekByteOff :: Ptr b -> Int -> IO a
- -- ^ Read a value from a memory location given by a base
- -- address and offset. The following equality holds:
- --
- -- > peekByteOff addr off = peek (addr `plusPtr` off)
-
- pokeByteOff :: Ptr b -> Int -> a -> IO ()
- -- ^ Write a value to a memory location given by a base
- -- address and offset. The following equality holds:
- --
- -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
-
- peek :: Ptr a -> IO a
- -- ^ Read a value from the given memory location.
- --
- -- Note that the peek and poke functions might require properly
- -- aligned addresses to function correctly. This is architecture
- -- dependent; thus, portable code should ensure that when peeking or
- -- poking values of some type @a@, the alignment
- -- constraint for @a@, as given by the function
- -- 'alignment' is fulfilled.
-
- poke :: Ptr a -> a -> IO ()
- -- ^ Write the given value to the given memory location. Alignment
- -- restrictions might apply; see 'peek'.
-
- -- circular default instances
-#ifdef __GLASGOW_HASKELL__
- peekElemOff = peekElemOff_ undefined
- where peekElemOff_ :: a -> Ptr a -> Int -> IO a
- peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef)
-#else
- peekElemOff ptr off = peekByteOff ptr (off * sizeOfPtr ptr undefined)
-#endif
- pokeElemOff ptr off val = pokeByteOff ptr (off * sizeOf val) val
-
- peekByteOff ptr off = peek (ptr `plusPtr` off)
- pokeByteOff ptr off = poke (ptr `plusPtr` off)
-
- peek ptr = peekElemOff ptr 0
- poke ptr = pokeElemOff ptr 0
-
-#ifndef __GLASGOW_HASKELL__
-sizeOfPtr :: Storable a => Ptr a -> a -> Int
-sizeOfPtr px x = sizeOf x
-#endif
-
--- System-dependent, but rather obvious instances
-
-instance Storable Bool where
- sizeOf _ = sizeOf (undefined::HTYPE_INT)
- alignment _ = alignment (undefined::HTYPE_INT)
- peekElemOff p i = liftM (/= (0::HTYPE_INT)) $ peekElemOff (castPtr p) i
- pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::HTYPE_INT)
-
-#define STORABLE(T,size,align,read,write) \
-instance Storable (T) where { \
- sizeOf _ = size; \
- alignment _ = align; \
- peekElemOff = read; \
- pokeElemOff = write }
-
-#ifdef __GLASGOW_HASKELL__
-STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
- readWideCharOffPtr,writeWideCharOffPtr)
-#elif defined(__HUGS__)
-STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,
- readCharOffPtr,writeCharOffPtr)
-#endif
-
-STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
- readIntOffPtr,writeIntOffPtr)
-
-#ifndef __NHC__
-STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
- readWordOffPtr,writeWordOffPtr)
-#endif
-
-STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
- readPtrOffPtr,writePtrOffPtr)
-
-STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
- readFunPtrOffPtr,writeFunPtrOffPtr)
-
-STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
- readStablePtrOffPtr,writeStablePtrOffPtr)
-
-STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
- readFloatOffPtr,writeFloatOffPtr)
-
-STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
- readDoubleOffPtr,writeDoubleOffPtr)
-
-STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
- readWord8OffPtr,writeWord8OffPtr)
-
-STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
- readWord16OffPtr,writeWord16OffPtr)
-
-STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
- readWord32OffPtr,writeWord32OffPtr)
-
-STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
- readWord64OffPtr,writeWord64OffPtr)
-
-STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
- readInt8OffPtr,writeInt8OffPtr)
-
-STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
- readInt16OffPtr,writeInt16OffPtr)
-
-STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
- readInt32OffPtr,writeInt32OffPtr)
-
-STORABLE(Int64,SIZEOF_INT64,ALIGNMENT_INT64,
- readInt64OffPtr,writeInt64OffPtr)
-
-#endif