X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FStorable.lhs;h=a722873865929329445cef6b7be4bf1d53ad1020;hb=be2750a0a11b919fb03cc070074e430f88bdfa90;hp=7441272c54bce76be3eb04287a82d8af051fd539;hpb=771f9ba7d06cd1b454d4bf2b133a028887a4d2af;p=ghc-base.git diff --git a/GHC/Storable.lhs b/GHC/Storable.lhs index 7441272..a722873 100644 --- a/GHC/Storable.lhs +++ b/GHC/Storable.lhs @@ -1,5 +1,7 @@ \begin{code} -{-# OPTIONS -fno-implicit-prelude -monly-3-regs #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-} +{-# OPTIONS_HADDOCK hide #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Storable @@ -10,249 +12,54 @@ -- Stability : internal -- Portability : non-portable (GHC Extensions) -- --- The 'Storable' class. +-- Helper functions for "Foreign.Storable" -- ----------------------------------------------------------------------------- -#include "MachDeps.h" - +-- #hide module GHC.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 () + ( readWideCharOffPtr + , readIntOffPtr + , readWordOffPtr + , readPtrOffPtr + , readFunPtrOffPtr + , readFloatOffPtr + , readDoubleOffPtr + , readStablePtrOffPtr + , readInt8OffPtr + , readInt16OffPtr + , readInt32OffPtr + , readInt64OffPtr + , readWord8OffPtr + , readWord16OffPtr + , readWord32OffPtr + , readWord64OffPtr + , writeWideCharOffPtr + , writeIntOffPtr + , writeWordOffPtr + , writePtrOffPtr + , writeFunPtrOffPtr + , writeFloatOffPtr + , writeDoubleOffPtr + , writeStablePtrOffPtr + , writeInt8OffPtr + , writeInt16OffPtr + , writeInt32OffPtr + , writeInt64OffPtr + , writeWord8OffPtr + , writeWord16OffPtr + , writeWord32OffPtr + , writeWord64OffPtr ) where -\end{code} -\begin{code} -import Control.Monad ( liftM ) -import Foreign.C.Types -import Foreign.C.TypesISO - -#ifdef __GLASGOW_HASKELL__ -import GHC.Stable ( StablePtr ) -import GHC.Num +import GHC.Stable ( StablePtr(..) ) import GHC.Int import GHC.Word -import GHC.Stable -import Foreign.Ptr -import GHC.Float -import GHC.Err -import GHC.IOBase +import GHC.Ptr import GHC.Base -#endif -\end{code} - -Primitive marshaling - -Minimal complete definition: sizeOf, alignment, and one definition -in each of the peek/poke families. - -\begin{code} -{- | -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 primtive 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 "CTypes" and -"CTypesISO", 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 - peekElemOff = peekElemOff_ undefined - where peekElemOff_ :: a -> Ptr a -> Int -> IO a - peekElemOff_ undef ptr off = peekByteOff ptr (off * sizeOf undef) - 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 \end{code} -System-dependent, but rather obvious instances - -\begin{code} -instance Storable Bool where - sizeOf _ = sizeOf (undefined::CInt) - alignment _ = alignment (undefined::CInt) - peekElemOff p i = liftM (/= (0::CInt)) $ peekElemOff (castPtr p) i - pokeElemOff p i x = pokeElemOff (castPtr p) i (if x then 1 else 0::CInt) - -#define STORABLE(T,size,align,read,write) \ -instance Storable (T) where { \ - sizeOf _ = size; \ - alignment _ = align; \ - peekElemOff = read; \ - pokeElemOff = write } - -STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32, - readWideCharOffPtr,writeWideCharOffPtr) - -STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT, - readIntOffPtr,writeIntOffPtr) - -STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD, - readWordOffPtr,writeWordOffPtr) - -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) - -#define NSTORABLE(T) \ -instance Storable T where { \ - sizeOf (T x) = sizeOf x ; \ - alignment (T x) = alignment x ; \ - peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \ - pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x } - -NSTORABLE(CChar) -NSTORABLE(CSChar) -NSTORABLE(CUChar) -NSTORABLE(CShort) -NSTORABLE(CUShort) -NSTORABLE(CInt) -NSTORABLE(CUInt) -NSTORABLE(CLong) -NSTORABLE(CULong) -NSTORABLE(CLLong) -NSTORABLE(CULLong) -NSTORABLE(CFloat) -NSTORABLE(CDouble) -NSTORABLE(CLDouble) -NSTORABLE(CPtrdiff) -NSTORABLE(CSize) -NSTORABLE(CWchar) -NSTORABLE(CSigAtomic) -NSTORABLE(CClock) -NSTORABLE(CTime) -\end{code} - -Helper functions - \begin{code} -#ifdef __GLASGOW_HASKELL__ readWideCharOffPtr :: Ptr Char -> Int -> IO Char readIntOffPtr :: Ptr Int -> Int -> IO Int @@ -354,5 +161,4 @@ writeInt64OffPtr (Ptr a) (I# i) (I64# x) writeWord64OffPtr (Ptr a) (I# i) (W64# x) = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #) -#endif /* __GLASGOW_HASKELL__ */ \end{code}