X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FC%2FTypes.hs;h=0eb64d03987cdb035806abfc82ca39d2b65e41ee;hb=1fac63ee84deab94a4263d4982e96c4ab8a8d9cb;hp=a36293e0105c96fefbc68980d49a95b0cdb3adbd;hpb=1db1d1749368c00079a1c764c9709908c2a92510;p=ghc-base.git

diff --git a/Foreign/C/Types.hs b/Foreign/C/Types.hs
index a36293e..0eb64d0 100644
--- a/Foreign/C/Types.hs
+++ b/Foreign/C/Types.hs
@@ -45,25 +45,13 @@ module Foreign.C.Types
 	, CFile,        CFpos,     CJmpBuf
 	) where
 
-#ifdef __NHC__
-import NHC.FFI
-  ( CChar(..),    CSChar(..),  CUChar(..)
-  , CShort(..),   CUShort(..), CInt(..),   CUInt(..)
-  , CLong(..),    CULong(..),  CLLong(..), CULLong(..)
-  , CPtrdiff(..), CSize(..),   CWchar(..), CSigAtomic(..)
-  , CClock(..),   CTime(..)
-  , CFloat(..),   CDouble(..), CLDouble(..)
-  , CFile,        CFpos,       CJmpBuf
-  , Storable(..)
-  )
-#else
+#ifndef __NHC__
 
-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 )
-import Data.Dynamic
+import Data.Typeable
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
@@ -78,7 +66,7 @@ import Control.Monad
 import Foreign.Ptr
 #endif
 
-#include "Dynamic.h"
+#include "Typeable.h"
 #include "CTypes.h"
 
 INTEGRAL_TYPE(CChar,tyConCChar,"CChar",HTYPE_CHAR)
@@ -128,4 +116,89 @@ FLOATING_TYPE(CDouble,tyConCDouble,"CDouble",HTYPE_DOUBLE)
 -- HACK: Currently no long double in the FFI, so we simply re-use double
 FLOATING_TYPE(CLDouble,tyConCLDouble,"CLDouble",HTYPE_DOUBLE)
 
+{-# RULES
+"realToFrac/a->CFloat"    realToFrac = \x -> CFloat   (realToFrac x)
+"realToFrac/a->CDouble"   realToFrac = \x -> CDouble  (realToFrac x)
+"realToFrac/a->CLDouble"  realToFrac = \x -> CLDouble (realToFrac x)
+
+"realToFrac/CFloat->a"    realToFrac = \(CFloat   x) -> realToFrac x
+"realToFrac/CDouble->a"   realToFrac = \(CDouble  x) -> realToFrac x
+"realToFrac/CLDouble->a"  realToFrac = \(CLDouble x) -> realToFrac x
+ #-}
+
+INTEGRAL_TYPE(CPtrdiff,tyConCPtrdiff,"CPtrdiff",HTYPE_PTRDIFF_T)
+INTEGRAL_TYPE(CSize,tyConCSize,"CSize",HTYPE_SIZE_T)
+INTEGRAL_TYPE(CWchar,tyConCWchar,"CWchar",HTYPE_WCHAR_T)
+INTEGRAL_TYPE(CSigAtomic,tyConCSigAtomic,"CSigAtomic",HTYPE_SIG_ATOMIC_T)
+
+{-# RULES
+"fromIntegral/a->CPtrdiff"   fromIntegral = \x -> CPtrdiff   (fromIntegral x)
+"fromIntegral/a->CSize"      fromIntegral = \x -> CSize      (fromIntegral x)
+"fromIntegral/a->CWchar"     fromIntegral = \x -> CWchar     (fromIntegral x)
+"fromIntegral/a->CSigAtomic" fromIntegral = \x -> CSigAtomic (fromIntegral x)
+
+"fromIntegral/CPtrdiff->a"   fromIntegral = \(CPtrdiff   x) -> fromIntegral x
+"fromIntegral/CSize->a"      fromIntegral = \(CSize      x) -> fromIntegral x
+"fromIntegral/CWchar->a"     fromIntegral = \(CWchar     x) -> fromIntegral x
+"fromIntegral/CSigAtomic->a" fromIntegral = \(CSigAtomic x) -> fromIntegral x
+ #-}
+
+ARITHMETIC_TYPE(CClock,tyConCClock,"CClock",HTYPE_CLOCK_T)
+ARITHMETIC_TYPE(CTime,tyConCTime,"CTime",HTYPE_TIME_T)
+
+-- FIXME: Implement and provide instances for Eq and Storable
+data CFile = CFile
+data CFpos = CFpos
+data CJmpBuf = CJmpBuf
+
+-- C99 types which are still missing include:
+-- intptr_t, uintptr_t, intmax_t, uintmax_t, wint_t, wctrans_t, wctype_t
+
+#else	/* __NHC__ */
+
+import NHC.FFI
+  ( CChar(..),    CSChar(..),  CUChar(..)
+  , CShort(..),   CUShort(..), CInt(..),   CUInt(..)
+  , CLong(..),    CULong(..),  CLLong(..), CULLong(..)
+  , CPtrdiff(..), CSize(..),   CWchar(..), CSigAtomic(..)
+  , CClock(..),   CTime(..)
+  , CFloat(..),   CDouble(..), CLDouble(..)
+  , CFile,        CFpos,       CJmpBuf
+  , Storable(..)
+  )
+import Data.Bits
+import NHC.SizedTypes
+
+#define INSTANCE_BITS(T) \
+instance Bits T where { \
+  (T x) .&.     (T y)   = T (x .&.   y) ; \
+  (T x) .|.     (T y)   = T (x .|.   y) ; \
+  (T x) `xor`   (T y)   = T (x `xor` y) ; \
+  complement    (T x)   = T (complement x) ; \
+  shift         (T x) n = T (shift x n) ; \
+  rotate        (T x) n = T (rotate x n) ; \
+  bit                 n = T (bit n) ; \
+  setBit        (T x) n = T (setBit x n) ; \
+  clearBit      (T x) n = T (clearBit x n) ; \
+  complementBit (T x) n = T (complementBit x n) ; \
+  testBit       (T x) n = testBit x n ; \
+  bitSize       (T x)   = bitSize x ; \
+  isSigned      (T x)   = isSigned x }
+
+INSTANCE_BITS(CChar)
+INSTANCE_BITS(CSChar)
+INSTANCE_BITS(CUChar)
+INSTANCE_BITS(CShort)
+INSTANCE_BITS(CUShort)
+INSTANCE_BITS(CInt)
+INSTANCE_BITS(CUInt)
+INSTANCE_BITS(CLong)
+INSTANCE_BITS(CULong)
+INSTANCE_BITS(CLLong)
+INSTANCE_BITS(CULLong)
+INSTANCE_BITS(CPtrdiff)
+INSTANCE_BITS(CWchar)
+INSTANCE_BITS(CSigAtomic)
+INSTANCE_BITS(CSize)
+
 #endif