X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FStorable.lhs;h=a722873865929329445cef6b7be4bf1d53ad1020;hb=41e8fba828acbae1751628af50849f5352b27873;hp=4868c6d80d3d8cebf927e0016e952d58ad3fad36;hpb=560dbd79c766044453b782e1aee6024a9c78dd76;p=ghc-base.git

diff --git a/GHC/Storable.lhs b/GHC/Storable.lhs
index 4868c6d..a722873 100644
--- a/GHC/Storable.lhs
+++ b/GHC/Storable.lhs
@@ -1,189 +1,65 @@
-% -----------------------------------------------------------------------------
-% $Id: Storable.lhs,v 1.2 2001/07/31 13:10:01 simonmar Exp $
-%
-% (c) The FFI task force, 2000
-%
-
-A class for primitive marshaling
-
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude -monly-3-regs #-}
-
-#include "MachDeps.h"
-
+{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- 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)
+--
+-- Helper functions for "Foreign.Storable"
+--
+-----------------------------------------------------------------------------
+
+-- #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 ()
-	     destruct)       -- :: Ptr 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 ()
-
-   -- free memory associated with the object
-   -- (except the object pointer itself)
-   destruct    :: Ptr 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
-
-   destruct _ = return ()
 \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_LONG,ALIGNMENT_LONG,
-	 readIntOffPtr,writeIntOffPtr)
-
-STORABLE(Word,SIZEOF_LONG,ALIGNMENT_LONG,
-	 readWordOffPtr,writeWordOffPtr)
-
-STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
-	 readPtrOffPtr,writePtrOffPtr)
-
-STORABLE((FunPtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
-	 readFunPtrOffPtr,writeFunPtrOffPtr)
-
-STORABLE((StablePtr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
-	 readStablePtrOffPtr,writeStablePtrOffPtr)
-
-STORABLE(Float,SIZEOF_FLOAT,ALIGNMENT_FLOAT,
-	 readFloatOffPtr,writeFloatOffPtr)
-
-STORABLE(Double,SIZEOF_DOUBLE,ALIGNMENT_DOUBLE,
-	 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
@@ -220,30 +96,20 @@ 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 #)
-readInt16OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readInt16OffAddr# a i s     of (# s2, x #) -> (# s2, I16# x #)
-readInt32OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readInt32OffAddr# a i s     of (# s2, x #) -> (# s2, I32# x #)
-#if WORD_SIZE_IN_BYTES == 4
-readInt64OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readInt64OffAddr# a i s     of (# s2, x #) -> (# s2, I64# x #)
-#else
-readInt64OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readIntOffAddr# a i s       of (# s2, x #) -> (# s2, I64# x #)
-#endif
 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 #)
-#if WORD_SIZE_IN_BYTES == 4
+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 #)
-#else
-readWord64OffPtr (Ptr a) (I# i)
-  = IO $ \s -> case readWordOffAddr# a i s      of (# s2, x #) -> (# s2, W64# x #)
-#endif
 
 writeWideCharOffPtr  :: Ptr Char          -> Int -> Char        -> IO ()
 writeIntOffPtr       :: Ptr Int           -> Int -> Int         -> IO ()
@@ -280,30 +146,19 @@ 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, () #)
-writeInt16OffPtr (Ptr a) (I# i) (I16# x)
-  = IO $ \s -> case writeInt16OffAddr# 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, () #)
-#if WORD_SIZE_IN_BYTES == 4
-writeInt64OffPtr (Ptr a) (I# i) (I64# x)
-  = IO $ \s -> case writeInt64OffAddr# a i x s     of s2 -> (# s2, () #)
-#else
-writeInt64OffPtr (Ptr a) (I# i) (I64# x)
-  = IO $ \s -> case writeIntOffAddr# a i x s       of s2 -> (# s2, () #)
-#endif
 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, () #)
-#if WORD_SIZE_IN_BYTES == 4
+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, () #)
-#else
-writeWord64OffPtr (Ptr a) (I# i) (W64# x)
-  = IO $ \s -> case writeWordOffAddr# a i x s      of s2 -> (# s2, () #)
-#endif
 
-#endif /* __GLASGOW_HASKELL__ */
 \end{code}