X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FStorable.hs;h=700a4ff5eeb9587e567a38302688a40e53cd0fcb;hb=be2750a0a11b919fb03cc070074e430f88bdfa90;hp=3b2823ef87c9588bdb121e11bc98e18857276bce;hpb=ea715b2c8255eefb3ce3dc434ee6e59f3229bde9;p=ghc-base.git diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs index 3b2823e..700a4ff 100644 --- a/Foreign/Storable.hs +++ b/Foreign/Storable.hs @@ -1,4 +1,5 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, ScopedTypeVariables #-} + ----------------------------------------------------------------------------- -- | -- Module : Foreign.Storable @@ -17,15 +18,15 @@ ----------------------------------------------------------------------------- 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 @@ -34,32 +35,30 @@ import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64) #else -import Control.Monad ( liftM ) +import Control.Monad ( liftM ) #include "MachDeps.h" -#include "config.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 #else import Data.Int import Data.Word -import Foreign.Ptr import Foreign.StablePtr #endif #ifdef __HUGS__ import Hugs.Prelude +import Hugs.Ptr import Hugs.Storable #endif @@ -81,7 +80,7 @@ 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 +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', @@ -181,66 +180,66 @@ instance Storable Bool where 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; \ +#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_HSCHAR,ALIGNMENT_HSCHAR, - readCharOffPtr,writeCharOffPtr) + 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) + readInt64OffPtr,writeInt64OffPtr) #endif