\begin{code}
-{-# OPTIONS -fno-implicit-prelude -monly-3-regs #-}
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Storable
-- 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}
-class Storable a where
-
- -- sizeOf/alignment *never* use their first argument
- sizeOf :: a -> Int
- alignment :: a -> Int
-
- -- replacement for read-/write???OffAddr
- peekElemOff :: Ptr a -> Int -> IO a
- pokeElemOff :: Ptr a -> Int -> a -> IO ()
-
- -- the same with *byte* offsets
- peekByteOff :: Ptr b -> Int -> IO a
- pokeByteOff :: Ptr b -> Int -> a -> IO ()
-
- -- ... and with no offsets at all
- peek :: Ptr a -> IO a
- poke :: Ptr a -> a -> IO ()
-
- -- 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
writeWord64OffPtr (Ptr a) (I# i) (W64# x)
= IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #)
-#endif /* __GLASGOW_HASKELL__ */
\end{code}
projects / ghc-base.git / blobdiff