-{-# OPTIONS -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Foreign.Storable
-----------------------------------------------------------------------------
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 ()
+ ( 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
-import Control.Monad ( liftM )
-import Foreign.Ptr
-import Foreign.C.Types
-import Foreign.C.TypesISO
+#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.Stable ( StablePtr )
+import GHC.IO() -- Instance Monad IO
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
-#elif defined(__HUGS__)
+#else
+import Data.Int
+import Data.Word
+import Foreign.StablePtr
+#endif
+
+#ifdef __HUGS__
+import Hugs.Prelude
+import Hugs.Ptr
import Hugs.Storable
#endif
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
+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 "CTypes" and
-"CTypesISO", as well as 'Ptr'.
+'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
-- @0@). The following equality holds,
--
-- > peekElemOff addr idx = IOExts.fixIO $ \result ->
- -- > peek (addr \`plusPtr\` (idx * sizeOf result))
+ -- > peek (addr `plusPtr` (idx * sizeOf result))
--
-- Note that this is only a specification, not
-- necessarily the concrete implementation of the
-- values of the same kind. The following equality holds:
--
-- > pokeElemOff addr idx x =
- -- > poke (addr \`plusPtr\` (idx * sizeOf x)) 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)
+ -- > 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
+ -- > pokeByteOff addr off x = poke (addr `plusPtr` off) x
peek :: Ptr a -> IO a
-- ^ Read a value from the given memory location.
-- System-dependent, but rather obvious instances
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; \
+ 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)
+ readWideCharOffPtr,writeWideCharOffPtr)
#elif defined(__HUGS__)
-STORABLE(Char,SIZEOF_CHAR,ALIGNMENT_HSCHAR,
- readCharOffPtr,writeCharOffPtr)
+STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,
+ readCharOffPtr,writeCharOffPtr)
#endif
STORABLE(Int,SIZEOF_HSINT,ALIGNMENT_HSINT,
- readIntOffPtr,writeIntOffPtr)
+ readIntOffPtr,writeIntOffPtr)
-#ifdef __GLASGOW_HASKELL__
+#ifndef __NHC__
STORABLE(Word,SIZEOF_HSWORD,ALIGNMENT_HSWORD,
- readWordOffPtr,writeWordOffPtr)
+ readWordOffPtr,writeWordOffPtr)
#endif
STORABLE((Ptr a),SIZEOF_HSPTR,ALIGNMENT_HSPTR,
- readPtrOffPtr,writePtrOffPtr)
+ readPtrOffPtr,writePtrOffPtr)
STORABLE((FunPtr a),SIZEOF_HSFUNPTR,ALIGNMENT_HSFUNPTR,
- readFunPtrOffPtr,writeFunPtrOffPtr)
+ readFunPtrOffPtr,writeFunPtrOffPtr)
STORABLE((StablePtr a),SIZEOF_HSSTABLEPTR,ALIGNMENT_HSSTABLEPTR,
- readStablePtrOffPtr,writeStablePtrOffPtr)
+ readStablePtrOffPtr,writeStablePtrOffPtr)
STORABLE(Float,SIZEOF_HSFLOAT,ALIGNMENT_HSFLOAT,
- readFloatOffPtr,writeFloatOffPtr)
+ readFloatOffPtr,writeFloatOffPtr)
STORABLE(Double,SIZEOF_HSDOUBLE,ALIGNMENT_HSDOUBLE,
- readDoubleOffPtr,writeDoubleOffPtr)
+ readDoubleOffPtr,writeDoubleOffPtr)
STORABLE(Word8,SIZEOF_WORD8,ALIGNMENT_WORD8,
- readWord8OffPtr,writeWord8OffPtr)
+ readWord8OffPtr,writeWord8OffPtr)
STORABLE(Word16,SIZEOF_WORD16,ALIGNMENT_WORD16,
- readWord16OffPtr,writeWord16OffPtr)
+ readWord16OffPtr,writeWord16OffPtr)
STORABLE(Word32,SIZEOF_WORD32,ALIGNMENT_WORD32,
- readWord32OffPtr,writeWord32OffPtr)
+ readWord32OffPtr,writeWord32OffPtr)
STORABLE(Word64,SIZEOF_WORD64,ALIGNMENT_WORD64,
- readWord64OffPtr,writeWord64OffPtr)
+ readWord64OffPtr,writeWord64OffPtr)
STORABLE(Int8,SIZEOF_INT8,ALIGNMENT_INT8,
- readInt8OffPtr,writeInt8OffPtr)
+ readInt8OffPtr,writeInt8OffPtr)
STORABLE(Int16,SIZEOF_INT16,ALIGNMENT_INT16,
- readInt16OffPtr,writeInt16OffPtr)
+ readInt16OffPtr,writeInt16OffPtr)
STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
- readInt32OffPtr,writeInt32OffPtr)
+ 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)
-#ifndef __HUGS__
-NSTORABLE(CLLong)
-NSTORABLE(CULLong)
+ readInt64OffPtr,writeInt64OffPtr)
+
#endif
-NSTORABLE(CFloat)
-NSTORABLE(CDouble)
-NSTORABLE(CLDouble)
-NSTORABLE(CPtrdiff)
-NSTORABLE(CSize)
-NSTORABLE(CWchar)
-NSTORABLE(CSigAtomic)
-NSTORABLE(CClock)
-NSTORABLE(CTime)
projects / ghc-base.git / blobdiff