X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FStorable.hs;h=700a4ff5eeb9587e567a38302688a40e53cd0fcb;hb=7a97ec4b12e1fbec5505f82032cf4dc435b5a60c;hp=869916dee61219fcea87f6192fb1b7482bc0617a;hpb=9fa9bc17072a58c0bae2cce4764d38677e96ac29;p=ghc-base.git diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs index 869916d..700a4ff 100644 --- a/Foreign/Storable.hs +++ b/Foreign/Storable.hs @@ -1,32 +1,245 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.Storable -- Copyright : (c) The FFI task force 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org -- Stability : provisional -- Portability : portable -- --- $Id: Storable.hs,v 1.4 2002/04/24 16:31:44 simonmar Exp $ --- --- A class for primitive marshaling +-- 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 + ( 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.IO() -- Instance Monad IO +import GHC.Num +import GHC.Int +import GHC.Word +import GHC.Ptr +import GHC.Err +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