From af4cc4743c0c26d43bed44cfbd72e2d18673c613 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 4 Sep 2002 16:05:30 +0000
Subject: [PATCH] [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.
---
 Foreign/C/Types.hs  |    1 +
 Foreign/Storable.hs |   42 +++++-------------------------------------
 include/CTypes.h    |   12 ++++++++++--
 3 files changed, 16 insertions(+), 39 deletions(-)

diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index e953d4a..ee9063e 100644
--- 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
--- 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
--- 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
 
-- 
1.7.10.4