[project @ 2002-09-04 16:05:29 by simonmar]

GHC can derive arbitrary instances for newtypes, so derive Storable
for the types in Foreign.C.Types, rather than using CPP trickery to
define the instances.

This moves the Storable instances for the C Types from
Foreign.Storable into Foreign.C.Types, and hence a few imports have
changed around.

diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index e953d4a..ee9063e 100644 (file)
--- a/Foreign/C/Types.hs
+++ b/Foreign/C/Types.hs
@@ -37,6 +37,7 @@ module Foreign.C.Types
        ) where
 
 import Foreign.C.TypesISO
+import Foreign.Storable
 import Data.Bits       ( Bits(..) )
 import Data.Int                ( Int8,  Int16,  Int32,  Int64  )
 import Data.Word       ( Word8, Word16, Word32, Word64 )

diff --git a/Foreign/Storable.hs b/Foreign/Storable.hs
index e59e7e4..c218fe8 100644 (file)
--- a/Foreign/Storable.hs
+++ b/Foreign/Storable.hs
@@ -30,11 +30,9 @@ module Foreign.Storable
 
 
 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
@@ -165,10 +163,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 {                  \
@@ -231,33 +229,3 @@ 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)

diff --git a/include/CTypes.h b/include/CTypes.h
index 64abde9..25b9ad8 100644 (file)
--- a/include/CTypes.h
+++ b/include/CTypes.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: CTypes.h,v 1.4 2002/08/20 10:03:05 simonmar Exp $
+ * $Id: CTypes.h,v 1.5 2002/09/04 16:05:29 simonmar Exp $
  *
  * Dirty CPP hackery for CTypes/CTypesISO
  *
@@ -21,6 +21,7 @@ INSTANCE_NUM(T) ; \
 INSTANCE_READ(T) ; \
 INSTANCE_SHOW(T) ; \
 INSTANCE_ENUM(T) ; \
+INSTANCE_STORABLE(T) : \
 INSTANCE_TYPEABLE0(T,C,S) ;
 
 #define INTEGRAL_TYPE(T,C,S,B) \
@@ -158,13 +159,20 @@ instance RealFloat T where { \
    isIEEE         (T x) = isIEEE x ; \
    (T x) `atan2`  (T y) = T (x `atan2` y) }
 
+#define INSTANCE_STORABLE(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 }
+
 #else /* __GLASGOW_HASKELL__ */
 
 /* GHC can derive any class for a newtype, so we make use of that
  * here...
  */
 
-#define NUMERIC_CLASSES  Eq,Ord,Num,Enum
+#define NUMERIC_CLASSES  Eq,Ord,Num,Enum,Storable
 #define INTEGRAL_CLASSES Bounded,Real,Integral,Bits
 #define FLOATING_CLASSES Real,Fractional,Floating,RealFrac,RealFloat