From: reid Date: Sat, 3 Aug 2002 19:32:17 +0000 (+0000) Subject: [project @ 2002-08-03 19:32:16 by reid] X-Git-Tag: nhc98-1-18-release~919 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=fd28932ae986f2a486b4b3463d7145d7f688048c;p=ghc-base.git [project @ 2002-08-03 19:32:16 by reid] Changes to make libs work with Hugs/FFI. Highlights: Moved most of the body of base/GHC/Storable.lhs into base/Foreign/Storable.lhs since it is mostly portable. base/include/CTypes.h and base/Foreign/C/Types.hs both generated Typeable instances for CChar and friends until I fixed them. --- diff --git a/Foreign/C/String.hs b/Foreign/C/String.hs index 06b27c4..b1603c3 100644 --- a/Foreign/C/String.hs +++ b/Foreign/C/String.hs @@ -52,6 +52,8 @@ import GHC.Real import GHC.Num import GHC.IOBase import GHC.Base +#else +#define unsafeChr chr #endif ----------------------------------------------------------------------------- diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs index ec1cbf1..df1b989 100644 --- a/Foreign/C/Types.hs +++ b/Foreign/C/Types.hs @@ -18,7 +18,10 @@ module Foreign.C.Types -- Typeable, Storable, Bounded, Real, Integral, Bits CChar(..), CSChar(..), CUChar(..) , CShort(..), CUShort(..), CInt(..), CUInt(..) - , CLong(..), CULong(..), CLLong(..), CULLong(..) + , CLong(..), CULong(..) +#ifndef __HUGS__ + , CLLong(..), CULLong(..) +#endif -- Floating types, instances of: Eq, Ord, Num, Read, Show, Enum, -- Typeable, Storable, Real, Fractional, Floating, RealFrac, @@ -41,6 +44,7 @@ import GHC.Read import GHC.Num #endif +#include "Dynamic.h" #include "CTypes.h" INTEGRAL_TYPE(CChar,tyConCChar,"CChar",HTYPE_CHAR) @@ -56,8 +60,10 @@ INTEGRAL_TYPE(CUInt,tyConCUInt,"CUInt",HTYPE_UNSIGNED_INT) INTEGRAL_TYPE(CLong,tyConCLong,"CLong",HTYPE_LONG) INTEGRAL_TYPE(CULong,tyConCULong,"CULong",HTYPE_UNSIGNED_LONG) +#ifndef __HUGS__ INTEGRAL_TYPE(CLLong,tyConCLLong,"CLLong",HTYPE_LONG_LONG) INTEGRAL_TYPE(CULLong,tyConCULLong,"CULLong",HTYPE_UNSIGNED_LONG_LONG) +#endif {-# RULES "fromIntegral/a->CChar" fromIntegral = \x -> CChar (fromIntegral x) @@ -90,24 +96,3 @@ FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE) -- HACK: Currently no long double in the FFI, so we simply re-use double FLOATING_TYPE(CLDouble,tyConCLDouble,"CLDouble",HTYPE_DOUBLE) - -#include "Dynamic.h" -INSTANCE_TYPEABLE0(CChar,cCharTc,"CChar") -INSTANCE_TYPEABLE0(CSChar,cSCharTc,"CSChar") -INSTANCE_TYPEABLE0(CUChar,cUCharTc,"CUChar") - -INSTANCE_TYPEABLE0(CShort,cShortTc,"CShort") -INSTANCE_TYPEABLE0(CUShort,cUShortTc,"CUShort") - -INSTANCE_TYPEABLE0(CInt,cIntTc,"CInt") -INSTANCE_TYPEABLE0(CUInt,cUIntTc,"CUInt") - -INSTANCE_TYPEABLE0(CLong,cLongTc,"CLong") -INSTANCE_TYPEABLE0(CULong,cULongTc,"CULong") - -INSTANCE_TYPEABLE0(CLLong,cLLongTc,"CLLong") -INSTANCE_TYPEABLE0(CULLong,cULLongTc,"CULLong") - -INSTANCE_TYPEABLE0(CFloat,cFloatTc,"CFloat") -INSTANCE_TYPEABLE0(CDouble,cDoubleTc,"CDouble") -INSTANCE_TYPEABLE0(CLDouble,cLDoubleTc,"CLDouble") diff --git a/Foreign/C/TypesISO.hs b/Foreign/C/TypesISO.hs index 6a364be..014c119 100644 --- a/Foreign/C/TypesISO.hs +++ b/Foreign/C/TypesISO.hs @@ -41,6 +41,7 @@ import GHC.Read import GHC.Num #endif +#include "Dynamic.h" #include "CTypes.h" INTEGRAL_TYPE(CPtrdiff,tyConCPtrdiff,"CPtrdiff",HTYPE_PTRDIFF_T) @@ -71,10 +72,3 @@ data CJmpBuf = CJmpBuf -- C99 types which are still missing include: -- intptr_t, uintptr_t, intmax_t, uintmax_t, wint_t, wctrans_t, wctype_t -#include "Dynamic.h" -INSTANCE_TYPEABLE0(CPtrdiff,cPtrdiffTc,"CPtrdiff") -INSTANCE_TYPEABLE0(CSize,cSizeTc,"CSize") -INSTANCE_TYPEABLE0(CWchar,cWcharTc,"CWchar") -INSTANCE_TYPEABLE0(CSigAtomic,cSigAtomicTc,"CSigAtomic") -INSTANCE_TYPEABLE0(CClock,cClockTc,"CClock") -INSTANCE_TYPEABLE0(CTime,cTimeTc,"CTime") diff --git a/Foreign/Storable.lhs b/Foreign/Storable.lhs new file mode 100644 index 0000000..0e457a2 --- /dev/null +++ b/Foreign/Storable.lhs @@ -0,0 +1,403 @@ +\begin{code} +{-# OPTIONS -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Storable +-- Copyright : (c) The FFI task force, 2000-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : ffi@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC Extensions) +-- +-- The 'Storable' class. +-- +----------------------------------------------------------------------------- + +#include "MachDeps.h" + +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 () + ) 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.Int +import GHC.Word +import GHC.Stable +import GHC.Ptr +import GHC.Float +import GHC.Err +import GHC.IOBase +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) + +#ifdef __GLASGOW_HASKELL__ +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) + +#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 +readWordOffPtr :: Ptr Word -> Int -> IO Word +readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) +readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a) +readFloatOffPtr :: Ptr Float -> Int -> IO Float +readDoubleOffPtr :: Ptr Double -> Int -> IO Double +readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) +readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 +readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 +readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 +readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 +readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 +readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 +readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 +readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 + +readWideCharOffPtr (Ptr a) (I# i) + = IO $ \s -> case readWideCharOffAddr# a i s of (# s2, x #) -> (# s2, C# x #) +readIntOffPtr (Ptr a) (I# i) + = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I# x #) +readWordOffPtr (Ptr a) (I# i) + = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W# x #) +readPtrOffPtr (Ptr a) (I# i) + = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, Ptr x #) +readFunPtrOffPtr (Ptr a) (I# i) + = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, FunPtr x #) +readFloatOffPtr (Ptr a) (I# i) + = IO $ \s -> case readFloatOffAddr# a i s of (# s2, x #) -> (# s2, F# x #) +readDoubleOffPtr (Ptr a) (I# i) + = IO $ \s -> case readDoubleOffAddr# a i s of (# s2, x #) -> (# s2, D# x #) +readStablePtrOffPtr (Ptr a) (I# i) + = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #) +readInt8OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #) +readWord8OffPtr (Ptr a) (I# i) + = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #) +readInt16OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #) +readWord16OffPtr (Ptr a) (I# i) + = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #) +readInt32OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #) +readWord32OffPtr (Ptr a) (I# i) + = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #) +readInt64OffPtr (Ptr a) (I# i) + = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #) +readWord64OffPtr (Ptr a) (I# i) + = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #) + +writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO () +writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () +writeWordOffPtr :: Ptr Word -> Int -> Word -> IO () +writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () +writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO () +writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () +writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () +writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () +writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () +writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () +writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () +writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () +writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () +writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () +writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () +writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () + +writeWideCharOffPtr (Ptr a) (I# i) (C# x) + = IO $ \s -> case writeWideCharOffAddr# a i x s of s2 -> (# s2, () #) +writeIntOffPtr (Ptr a) (I# i) (I# x) + = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #) +writeWordOffPtr (Ptr a) (I# i) (W# x) + = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #) +writePtrOffPtr (Ptr a) (I# i) (Ptr x) + = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) +writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x) + = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) +writeFloatOffPtr (Ptr a) (I# i) (F# x) + = IO $ \s -> case writeFloatOffAddr# a i x s of s2 -> (# s2, () #) +writeDoubleOffPtr (Ptr a) (I# i) (D# x) + = IO $ \s -> case writeDoubleOffAddr# a i x s of s2 -> (# s2, () #) +writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x) + = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #) +writeInt8OffPtr (Ptr a) (I# i) (I8# x) + = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #) +writeWord8OffPtr (Ptr a) (I# i) (W8# x) + = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #) +writeInt16OffPtr (Ptr a) (I# i) (I16# x) + = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #) +writeWord16OffPtr (Ptr a) (I# i) (W16# x) + = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #) +writeInt32OffPtr (Ptr a) (I# i) (I32# x) + = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #) +writeWord32OffPtr (Ptr a) (I# i) (W32# x) + = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #) +writeInt64OffPtr (Ptr a) (I# i) (I64# x) + = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #) +writeWord64OffPtr (Ptr a) (I# i) (W64# x) + = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #) + +#elif defined(__HUGS__) +/* + * You might be surprised to find Hugs code in GHC.Storable - no more + * surprised though than I was to find so much machine-independent code + * hiding in the GHC directory. - ADR + */ + +foreign import ccall unsafe "Storable_aux.h" readIntOffPtr :: Ptr Int -> Int -> IO Int +foreign import ccall unsafe "Storable_aux.h" readCharOffPtr :: Ptr Char -> Int -> IO Char +-- foreign import ccall unsafe "Storable_aux.h" readWideCharOffPtr :: Ptr Char -> Int -> IO Char +-- foreign import ccall unsafe "Storable_aux.h" readWordOffPtr :: Ptr Word -> Int -> IO Word +foreign import ccall unsafe "Storable_aux.h" readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) +foreign import ccall unsafe "Storable_aux.h" readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a) +foreign import ccall unsafe "Storable_aux.h" readFloatOffPtr :: Ptr Float -> Int -> IO Float +foreign import ccall unsafe "Storable_aux.h" readDoubleOffPtr :: Ptr Double -> Int -> IO Double +foreign import ccall unsafe "Storable_aux.h" readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) +foreign import ccall unsafe "Storable_aux.h" readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 +foreign import ccall unsafe "Storable_aux.h" readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 +foreign import ccall unsafe "Storable_aux.h" readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 +foreign import ccall unsafe "Storable_aux.h" readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 +foreign import ccall unsafe "Storable_aux.h" readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 +foreign import ccall unsafe "Storable_aux.h" readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 +foreign import ccall unsafe "Storable_aux.h" readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 +foreign import ccall unsafe "Storable_aux.h" readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 + +foreign import ccall unsafe "Storable_aux.h" writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () +foreign import ccall unsafe "Storable_aux.h" writeCharOffPtr :: Ptr Char -> Int -> Char -> IO () +foreign import ccall unsafe "Storable_aux.h" writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO () +foreign import ccall unsafe "Storable_aux.h" writeWordOffPtr :: Ptr Word -> Int -> Word -> IO () +foreign import ccall unsafe "Storable_aux.h" writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () +foreign import ccall unsafe "Storable_aux.h" writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO () +foreign import ccall unsafe "Storable_aux.h" writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () +foreign import ccall unsafe "Storable_aux.h" writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () +foreign import ccall unsafe "Storable_aux.h" writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () +foreign import ccall unsafe "Storable_aux.h" writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () +foreign import ccall unsafe "Storable_aux.h" writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () + +#endif /* __HUGS__ */ +\end{code} diff --git a/GHC/Storable.lhs b/GHC/Storable.lhs index 9a4e038..6bd932b 100644 --- a/GHC/Storable.lhs +++ b/GHC/Storable.lhs @@ -2,21 +2,22 @@ {-# OPTIONS -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | --- Module : GHC.Storable --- Copyright : (c) The FFI task force, 2000-2002 +-- Module : Foreign.Storable +-- Copyright : (c) The FFI task force 2001 -- License : see libraries/base/LICENSE -- -- Maintainer : ffi@haskell.org --- Stability : internal --- Portability : non-portable (GHC Extensions) +-- Stability : provisional +-- Portability : portable -- --- The 'Storable' class. +-- The module "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. -- ----------------------------------------------------------------------------- -#include "MachDeps.h" - -module GHC.Storable +module Foreign.Storable ( Storable( sizeOf, -- :: a -> Int alignment, -- :: a -> Int @@ -35,16 +36,9 @@ import Foreign.C.Types import Foreign.C.TypesISO #ifdef __GLASGOW_HASKELL__ -import GHC.Stable ( StablePtr ) -import GHC.Num -import GHC.Int -import GHC.Word -import GHC.Stable -import GHC.Ptr -import GHC.Float -import GHC.Err -import GHC.IOBase -import GHC.Base +import GHC.Storable +#elif defined(__HUGS__) +import HugsStorable #endif \end{code} @@ -178,8 +172,10 @@ STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32, STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT, readIntOffPtr,writeIntOffPtr) +#ifdef __GLASGOW_HASKELL__ STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD, readWordOffPtr,writeWordOffPtr) +#endif STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR, readPtrOffPtr,writePtrOffPtr) @@ -248,111 +244,3 @@ 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 -readWordOffPtr :: Ptr Word -> Int -> IO Word -readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a) -readFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> IO (FunPtr a) -readFloatOffPtr :: Ptr Float -> Int -> IO Float -readDoubleOffPtr :: Ptr Double -> Int -> IO Double -readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a) -readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8 -readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16 -readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32 -readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64 -readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8 -readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16 -readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32 -readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64 - -readWideCharOffPtr (Ptr a) (I# i) - = IO $ \s -> case readWideCharOffAddr# a i s of (# s2, x #) -> (# s2, C# x #) -readIntOffPtr (Ptr a) (I# i) - = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I# x #) -readWordOffPtr (Ptr a) (I# i) - = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W# x #) -readPtrOffPtr (Ptr a) (I# i) - = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, Ptr x #) -readFunPtrOffPtr (Ptr a) (I# i) - = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, FunPtr x #) -readFloatOffPtr (Ptr a) (I# i) - = IO $ \s -> case readFloatOffAddr# a i s of (# s2, x #) -> (# s2, F# x #) -readDoubleOffPtr (Ptr a) (I# i) - = IO $ \s -> case readDoubleOffAddr# a i s of (# s2, x #) -> (# s2, D# x #) -readStablePtrOffPtr (Ptr a) (I# i) - = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #) -readInt8OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #) -readWord8OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #) -readInt16OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #) -readWord16OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #) -readInt32OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #) -readWord32OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #) -readInt64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #) -readWord64OffPtr (Ptr a) (I# i) - = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #) - -writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO () -writeIntOffPtr :: Ptr Int -> Int -> Int -> IO () -writeWordOffPtr :: Ptr Word -> Int -> Word -> IO () -writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO () -writeFunPtrOffPtr :: Ptr (FunPtr a) -> Int -> FunPtr a -> IO () -writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO () -writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO () -writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO () -writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO () -writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO () -writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO () -writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO () -writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO () -writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO () -writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO () -writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO () - -writeWideCharOffPtr (Ptr a) (I# i) (C# x) - = IO $ \s -> case writeWideCharOffAddr# a i x s of s2 -> (# s2, () #) -writeIntOffPtr (Ptr a) (I# i) (I# x) - = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #) -writeWordOffPtr (Ptr a) (I# i) (W# x) - = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #) -writePtrOffPtr (Ptr a) (I# i) (Ptr x) - = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) -writeFunPtrOffPtr (Ptr a) (I# i) (FunPtr x) - = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #) -writeFloatOffPtr (Ptr a) (I# i) (F# x) - = IO $ \s -> case writeFloatOffAddr# a i x s of s2 -> (# s2, () #) -writeDoubleOffPtr (Ptr a) (I# i) (D# x) - = IO $ \s -> case writeDoubleOffAddr# a i x s of s2 -> (# s2, () #) -writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x) - = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #) -writeInt8OffPtr (Ptr a) (I# i) (I8# x) - = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #) -writeWord8OffPtr (Ptr a) (I# i) (W8# x) - = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #) -writeInt16OffPtr (Ptr a) (I# i) (I16# x) - = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #) -writeWord16OffPtr (Ptr a) (I# i) (W16# x) - = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #) -writeInt32OffPtr (Ptr a) (I# i) (I32# x) - = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #) -writeWord32OffPtr (Ptr a) (I# i) (W32# x) - = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #) -writeInt64OffPtr (Ptr a) (I# i) (I64# x) - = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #) -writeWord64OffPtr (Ptr a) (I# i) (W64# x) - = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #) - -#endif /* __GLASGOW_HASKELL__ */ -\end{code} diff --git a/include/CTypes.h b/include/CTypes.h index 9827d9d..cc0ea74 100644 --- a/include/CTypes.h +++ b/include/CTypes.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: CTypes.h,v 1.2 2001/12/21 15:07:26 simonmar Exp $ + * $Id: CTypes.h,v 1.3 2002/08/03 19:32:17 reid Exp $ * * Dirty CPP hackery for CTypes/CTypesISO * @@ -21,7 +21,7 @@ INSTANCE_NUM(T) ; \ INSTANCE_READ(T) ; \ INSTANCE_SHOW(T) ; \ INSTANCE_ENUM(T) ; \ -INSTANCE_TYPEABLE(T,C,S) ; +INSTANCE_TYPEABLE0(T,C,S) ; #define INTEGRAL_TYPE(T,C,S,B) \ NUMERIC_TYPE(T,C,S,B) ; \ @@ -38,6 +38,10 @@ INSTANCE_FLOATING(T) ; \ INSTANCE_REALFRAC(T) ; \ INSTANCE_REALFLOAT(T) +#ifndef __GLASGOW_HASKELL__ +#define fakeMap map +#endif + #define INSTANCE_READ(T) \ instance Read T where { \ readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) } @@ -56,12 +60,6 @@ instance Num T where { \ signum (T i) = T (signum i) ; \ fromInteger x = T (fromInteger x) } -#define INSTANCE_TYPEABLE(T,C,S) \ -C :: TyCon ; \ -C = mkTyCon S ; \ -instance Typeable T where { \ - typeOf _ = mkAppTy C [] } - #define INSTANCE_BOUNDED(T) \ instance Bounded T where { \ minBound = T minBound ; \