include/CTypes.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: CTypes.h,v 1.6 2002/09/04 16:46:40 ross Exp $
   3  *
   4  * Dirty CPP hackery for CTypes/CTypesISO
   5  *
   6  * (c) The FFI task force, 2000
   7  * -------------------------------------------------------------------------- */
   8
   9 #include "MachDeps.h"
  10
  11 /* As long as there is no automatic derivation of classes for newtypes we resort
  12    to extremely dirty cpp-hackery.   :-P   Some care has to be taken when the
  13    macros below are modified, otherwise the layout rule will bite you. */
  14
  15 /* A hacked version for GHC follows the Haskell 98 version... */
  16 #ifndef __GLASGOW_HASKELL__
  17
  18 #define NUMERIC_TYPE(T,C,S,B) \
  19 newtype T = T B deriving (Eq, Ord) ; \
  20 INSTANCE_NUM(T) ; \
  21 INSTANCE_READ(T) ; \
  22 INSTANCE_SHOW(T) ; \
  23 INSTANCE_ENUM(T) ; \
  24 INSTANCE_STORABLE(T) ; \
  25 INSTANCE_TYPEABLE0(T,C,S) ;
  26
  27 #define INTEGRAL_TYPE(T,C,S,B) \
  28 NUMERIC_TYPE(T,C,S,B) ; \
  29 INSTANCE_BOUNDED(T) ; \
  30 INSTANCE_REAL(T) ; \
  31 INSTANCE_INTEGRAL(T) ; \
  32 INSTANCE_BITS(T)
  33
  34 #define FLOATING_TYPE(T,C,S,B) \
  35 NUMERIC_TYPE(T,C,S,B) ; \
  36 INSTANCE_REAL(T) ; \
  37 INSTANCE_FRACTIONAL(T) ; \
  38 INSTANCE_FLOATING(T) ; \
  39 INSTANCE_REALFRAC(T) ; \
  40 INSTANCE_REALFLOAT(T)
  41
  42 #ifndef __GLASGOW_HASKELL__
  43 #define fakeMap map
  44 #endif
  45
  46 #define INSTANCE_READ(T) \
  47 instance Read T where { \
  48    readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) }
  49
  50 #define INSTANCE_SHOW(T) \
  51 instance Show T where { \
  52    showsPrec p (T x) = showsPrec p x }
  53
  54 #define INSTANCE_NUM(T) \
  55 instance Num T where { \
  56    (T i) + (T j) = T (i + j) ; \
  57    (T i) - (T j) = T (i - j) ; \
  58    (T i) * (T j) = T (i * j) ; \
  59    negate  (T i) = T (negate i) ; \
  60    abs     (T i) = T (abs    i) ; \
  61    signum  (T i) = T (signum i) ; \
  62    fromInteger x = T (fromInteger x) }
  63
  64 #define INSTANCE_BOUNDED(T) \
  65 instance Bounded T where { \
  66    minBound = T minBound ; \
  67    maxBound = T maxBound }
  68
  69 #define INSTANCE_ENUM(T) \
  70 instance Enum T where { \
  71    succ           (T i)             = T (succ i) ; \
  72    pred           (T i)             = T (pred i) ; \
  73    toEnum               x           = T (toEnum x) ; \
  74    fromEnum       (T i)             = fromEnum i ; \
  75    enumFrom       (T i)             = fakeMap T (enumFrom i) ; \
  76    enumFromThen   (T i) (T j)       = fakeMap T (enumFromThen i j) ; \
  77    enumFromTo     (T i) (T j)       = fakeMap T (enumFromTo i j) ; \
  78    enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) }
  79
  80 #define INSTANCE_REAL(T) \
  81 instance Real T where { \
  82    toRational (T i) = toRational i }
  83
  84 #define INSTANCE_INTEGRAL(T) \
  85 instance Integral T where { \
  86    (T i) `quot`    (T j) = T (i `quot` j) ; \
  87    (T i) `rem`     (T j) = T (i `rem`  j) ; \
  88    (T i) `div`     (T j) = T (i `div`  j) ; \
  89    (T i) `mod`     (T j) = T (i `mod`  j) ; \
  90    (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \
  91    (T i) `divMod`  (T j) = let (d,m) = i `divMod`  j in (T d, T m) ; \
  92    toInteger (T i)       = toInteger i }
  93
  94 #define INSTANCE_BITS(T) \
  95 instance Bits T where { \
  96   (T x) .&.     (T y)   = T (x .&.   y) ; \
  97   (T x) .|.     (T y)   = T (x .|.   y) ; \
  98   (T x) `xor`   (T y)   = T (x `xor` y) ; \
  99   complement    (T x)   = T (complement x) ; \
 100   shift         (T x) n = T (shift x n) ; \
 101   rotate        (T x) n = T (rotate x n) ; \
 102   bit                 n = T (bit n) ; \
 103   setBit        (T x) n = T (setBit x n) ; \
 104   clearBit      (T x) n = T (clearBit x n) ; \
 105   complementBit (T x) n = T (complementBit x n) ; \
 106   testBit       (T x) n = testBit x n ; \
 107   bitSize       (T x)   = bitSize x ; \
 108   isSigned      (T x)   = isSigned x }
 109
 110 #define INSTANCE_FRACTIONAL(T) \
 111 instance Fractional T where { \
 112    (T x) / (T y)  = T (x / y) ; \
 113    recip   (T x)  = T (recip x) ; \
 114    fromRational r = T (fromRational r) }
 115
 116 #define INSTANCE_FLOATING(T) \
 117 instance Floating T where { \
 118    pi                    = pi ; \
 119    exp   (T x)           = T (exp   x) ; \
 120    log   (T x)           = T (log   x) ; \
 121    sqrt  (T x)           = T (sqrt  x) ; \
 122    (T x) **        (T y) = T (x ** y) ; \
 123    (T x) `logBase` (T y) = T (x `logBase` y) ; \
 124    sin   (T x)           = T (sin   x) ; \
 125    cos   (T x)           = T (cos   x) ; \
 126    tan   (T x)           = T (tan   x) ; \
 127    asin  (T x)           = T (asin  x) ; \
 128    acos  (T x)           = T (acos  x) ; \
 129    atan  (T x)           = T (atan  x) ; \
 130    sinh  (T x)           = T (sinh  x) ; \
 131    cosh  (T x)           = T (cosh  x) ; \
 132    tanh  (T x)           = T (tanh  x) ; \
 133    asinh (T x)           = T (asinh x) ; \
 134    acosh (T x)           = T (acosh x) ; \
 135    atanh (T x)           = T (atanh x) }
 136
 137 #define INSTANCE_REALFRAC(T) \
 138 instance RealFrac T where { \
 139    properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \
 140    truncate (T x) = truncate x ; \
 141    round    (T x) = round x ; \
 142    ceiling  (T x) = ceiling x ; \
 143    floor    (T x) = floor x }
 144
 145 #define INSTANCE_REALFLOAT(T) \
 146 instance RealFloat T where { \
 147    floatRadix     (T x) = floatRadix x ; \
 148    floatDigits    (T x) = floatDigits x ; \
 149    floatRange     (T x) = floatRange x ; \
 150    decodeFloat    (T x) = decodeFloat x ; \
 151    encodeFloat m n      = T (encodeFloat m n) ; \
 152    exponent       (T x) = exponent x ; \
 153    significand    (T x) = T (significand  x) ; \
 154    scaleFloat n   (T x) = T (scaleFloat n x) ; \
 155    isNaN          (T x) = isNaN x ; \
 156    isInfinite     (T x) = isInfinite x ; \
 157    isDenormalized (T x) = isDenormalized x ; \
 158    isNegativeZero (T x) = isNegativeZero x ; \
 159    isIEEE         (T x) = isIEEE x ; \
 160    (T x) `atan2`  (T y) = T (x `atan2` y) }
 161
 162 #define INSTANCE_STORABLE(T) \
 163 instance Storable T where { \
 164    sizeOf    (T x)       = sizeOf x ; \
 165    alignment (T x)       = alignment x ; \
 166    peekElemOff a i       = liftM T (peekElemOff (castPtr a) i) ; \
 167    pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x }
 168
 169 #else /* __GLASGOW_HASKELL__ */
 170
 171 /* GHC can derive any class for a newtype, so we make use of that
 172  * here...
 173  */
 174
 175 #define NUMERIC_CLASSES  Eq,Ord,Num,Enum,Storable
 176 #define INTEGRAL_CLASSES Bounded,Real,Integral,Bits
 177 #define FLOATING_CLASSES Real,Fractional,Floating,RealFrac,RealFloat
 178
 179 #define NUMERIC_TYPE(T,C,S,B) \
 180 newtype T = T B deriving (NUMERIC_CLASSES); \
 181 INSTANCE_READ(T,B); \
 182 INSTANCE_SHOW(T,B); \
 183 INSTANCE_TYPEABLE0(T,C,S) ;
 184
 185 #define INTEGRAL_TYPE(T,C,S,B) \
 186 newtype T = T B deriving (NUMERIC_CLASSES, INTEGRAL_CLASSES); \
 187 INSTANCE_READ(T,B); \
 188 INSTANCE_SHOW(T,B); \
 189 INSTANCE_TYPEABLE0(T,C,S) ;
 190
 191 #define FLOATING_TYPE(T,C,S,B) \
 192 newtype T = T B deriving (NUMERIC_CLASSES, FLOATING_CLASSES); \
 193 INSTANCE_READ(T,B); \
 194 INSTANCE_SHOW(T,B); \
 195 INSTANCE_TYPEABLE0(T,C,S) ;
 196
 197 #define INSTANCE_READ(T,B) \
 198 instance Read T where { \
 199    readsPrec            = unsafeCoerce# (readsPrec :: Int -> ReadS B); \
 200    readList             = unsafeCoerce# (readList  :: ReadS [B]); }
 201
 202 #define INSTANCE_SHOW(T,B) \
 203 instance Show T where { \
 204    showsPrec            = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \
 205    show                 = unsafeCoerce# (show :: B -> String); \
 206    showList             = unsafeCoerce# (showList :: [B] -> ShowS); }
 207
 208 #endif /* __GLASGOW_HASKELL__ */