[project @ 2004-06-13 21:03:46 by panne]

[haskell-directory.git] / Foreign / Storable.hs

diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs
index e59e7e4..3b2823e 100644 (file)
--- a/Foreign/Storable.hs
+++ b/Foreign/Storable.hs
@@ -29,12 +29,15 @@ module Foreign.Storable
         ) where
 
 
+#ifdef __NHC__
+import NHC.FFI (Storable(..),Ptr,FunPtr,StablePtr
+               ,Int8,Int16,Int32,Int64,Word8,Word16,Word32,Word64)
+#else
+
 import Control.Monad           ( liftM )
-import Foreign.Ptr
-import Foreign.C.Types
-import Foreign.C.TypesISO
 
 #include "MachDeps.h"
+#include "config.h"
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Storable
@@ -48,7 +51,15 @@ import GHC.Float
 import GHC.Err
 import GHC.IOBase
 import GHC.Base
-#elif defined(__HUGS__)
+#else
+import Data.Int
+import Data.Word
+import Foreign.Ptr
+import Foreign.StablePtr
+#endif
+
+#ifdef __HUGS__
+import Hugs.Prelude
 import Hugs.Storable
 #endif
 
@@ -75,8 +86,8 @@ 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
@@ -102,7 +113,7 @@ class Storable a where
    --         @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
@@ -113,19 +124,19 @@ class Storable a where
    --         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.
@@ -165,10 +176,10 @@ sizeOfPtr px x = sizeOf x
 -- 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)
+   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 {                  \
@@ -181,7 +192,7 @@ instance Storable (T) where {                       \
 STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
         readWideCharOffPtr,writeWideCharOffPtr)
 #elif defined(__HUGS__)
-STORABLE(Char,SIZEOF_CHAR,ALIGNMENT_HSCHAR,
+STORABLE(Char,SIZEOF_HSCHAR,ALIGNMENT_HSCHAR,
         readCharOffPtr,writeCharOffPtr)
 #endif
 
@@ -232,32 +243,4 @@ STORABLE(Int32,SIZEOF_INT32,ALIGNMENT_INT32,
 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)
 #endif
-NSTORABLE(CFloat)
-NSTORABLE(CDouble)
-NSTORABLE(CLDouble)
-NSTORABLE(CPtrdiff)
-NSTORABLE(CSize)
-NSTORABLE(CWchar)
-NSTORABLE(CSigAtomic)
-NSTORABLE(CClock)
-NSTORABLE(CTime)