ghc/lib/std/cbits/CTypes.h

   1 /* -----------------------------------------------------------------------------
   2  * $Id: CTypes.h,v 1.1 2001/01/11 17:25:58 simonmar 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_TYPEABLE(T,C,S) ;
  25
  26 #define INTEGRAL_TYPE(T,C,S,B) \
  27 NUMERIC_TYPE(T,C,S,B) ; \
  28 INSTANCE_BOUNDED(T) ; \
  29 INSTANCE_REAL(T) ; \
  30 INSTANCE_INTEGRAL(T) ; \
  31 INSTANCE_BITS(T)
  32
  33 #define FLOATING_TYPE(T,C,S,B) \
  34 NUMERIC_TYPE(T,C,S,B) ; \
  35 INSTANCE_REAL(T) ; \
  36 INSTANCE_FRACTIONAL(T) ; \
  37 INSTANCE_FLOATING(T) ; \
  38 INSTANCE_REALFRAC(T) ; \
  39 INSTANCE_REALFLOAT(T)
  40
  41 #define INSTANCE_READ(T) \
  42 instance Read T where { \
  43    readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) }
  44
  45 #define INSTANCE_SHOW(T) \
  46 instance Show T where { \
  47    showsPrec p (T x) = showsPrec p x }
  48
  49 #define INSTANCE_NUM(T) \
  50 instance Num T where { \
  51    (T i) + (T j) = T (i + j) ; \
  52    (T i) - (T j) = T (i - j) ; \
  53    (T i) * (T j) = T (i * j) ; \
  54    negate  (T i) = T (negate i) ; \
  55    abs     (T i) = T (abs    i) ; \
  56    signum  (T i) = T (signum i) ; \
  57    fromInteger x = T (fromInteger x) }
  58
  59 #define INSTANCE_TYPEABLE(T,C,S) \
  60 C :: TyCon ; \
  61 C = mkTyCon S ; \
  62 instance Typeable T where { \
  63   typeOf _ = mkAppTy C [] }
  64
  65 #define INSTANCE_STORABLE(T) \
  66 instance Storable T where { \
  67    sizeOf    (T x)       = sizeOf x ; \
  68    alignment (T x)       = alignment x ; \
  69    peekElemOff a i       = liftM T (peekElemOff a i) ; \
  70    pokeElemOff a i (T x) = pokeElemOff a i x }
  71
  72 #define INSTANCE_BOUNDED(T) \
  73 instance Bounded T where { \
  74    minBound = T minBound ; \
  75    maxBound = T maxBound }
  76
  77 #define INSTANCE_ENUM(T) \
  78 instance Enum T where { \
  79    succ           (T i)             = T (succ i) ; \
  80    pred           (T i)             = T (pred i) ; \
  81    toEnum               x           = T (toEnum x) ; \
  82    fromEnum       (T i)             = fromEnum i ; \
  83    enumFrom       (T i)             = fakeMap T (enumFrom i) ; \
  84    enumFromThen   (T i) (T j)       = fakeMap T (enumFromThen i j) ; \
  85    enumFromTo     (T i) (T j)       = fakeMap T (enumFromTo i j) ; \
  86    enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) }
  87
  88 #define INSTANCE_REAL(T) \
  89 instance Real T where { \
  90    toRational (T i) = toRational i }
  91
  92 #define INSTANCE_INTEGRAL(T) \
  93 instance Integral T where { \
  94    (T i) `quot`    (T j) = T (i `quot` j) ; \
  95    (T i) `rem`     (T j) = T (i `rem`  j) ; \
  96    (T i) `div`     (T j) = T (i `div`  j) ; \
  97    (T i) `mod`     (T j) = T (i `mod`  j) ; \
  98    (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \
  99    (T i) `divMod`  (T j) = let (d,m) = i `divMod`  j in (T d, T m) ; \
 100    toInteger (T i)       = toInteger i ; \
 101    toInt     (T i)       = toInt     i }
 102
 103 #define INSTANCE_BITS(T) \
 104 instance Bits T where { \
 105   (T x) .&.     (T y)   = T (x .&.   y) ; \
 106   (T x) .|.     (T y)   = T (x .|.   y) ; \
 107   (T x) `xor`   (T y)   = T (x `xor` y) ; \
 108   complement    (T x)   = T (complement x) ; \
 109   shift         (T x) n = T (shift x n) ; \
 110   rotate        (T x) n = T (rotate x n) ; \
 111   bit                 n = T (bit n) ; \
 112   setBit        (T x) n = T (setBit x n) ; \
 113   clearBit      (T x) n = T (clearBit x n) ; \
 114   complementBit (T x) n = T (complementBit x n) ; \
 115   testBit       (T x) n = testBit x n ; \
 116   bitSize       (T x)   = bitSize x ; \
 117   isSigned      (T x)   = isSigned x }
 118
 119 #define INSTANCE_FRACTIONAL(T) \
 120 instance Fractional T where { \
 121    (T x) / (T y)  = T (x / y) ; \
 122    recip   (T x)  = T (recip x) ; \
 123    fromRational r = T (fromRational r) }
 124
 125 #define INSTANCE_FLOATING(T) \
 126 instance Floating T where { \
 127    pi                    = pi ; \
 128    exp   (T x)           = T (exp   x) ; \
 129    log   (T x)           = T (log   x) ; \
 130    sqrt  (T x)           = T (sqrt  x) ; \
 131    (T x) **        (T y) = T (x ** y) ; \
 132    (T x) `logBase` (T y) = T (x `logBase` y) ; \
 133    sin   (T x)           = T (sin   x) ; \
 134    cos   (T x)           = T (cos   x) ; \
 135    tan   (T x)           = T (tan   x) ; \
 136    asin  (T x)           = T (asin  x) ; \
 137    acos  (T x)           = T (acos  x) ; \
 138    atan  (T x)           = T (atan  x) ; \
 139    sinh  (T x)           = T (sinh  x) ; \
 140    cosh  (T x)           = T (cosh  x) ; \
 141    tanh  (T x)           = T (tanh  x) ; \
 142    asinh (T x)           = T (asinh x) ; \
 143    acosh (T x)           = T (acosh x) ; \
 144    atanh (T x)           = T (atanh x) }
 145
 146 #define INSTANCE_REALFRAC(T) \
 147 instance RealFrac T where { \
 148    properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \
 149    truncate (T x) = truncate x ; \
 150    round    (T x) = round x ; \
 151    ceiling  (T x) = ceiling x ; \
 152    floor    (T x) = floor x }
 153
 154 #define INSTANCE_REALFLOAT(T) \
 155 instance RealFloat T where { \
 156    floatRadix     (T x) = floatRadix x ; \
 157    floatDigits    (T x) = floatDigits x ; \
 158    floatRange     (T x) = floatRange x ; \
 159    decodeFloat    (T x) = decodeFloat x ; \
 160    encodeFloat m n      = T (encodeFloat m n) ; \
 161    exponent       (T x) = exponent x ; \
 162    significand    (T x) = T (significand  x) ; \
 163    scaleFloat n   (T x) = T (scaleFloat n x) ; \
 164    isNaN          (T x) = isNaN x ; \
 165    isInfinite     (T x) = isInfinite x ; \
 166    isDenormalized (T x) = isDenormalized x ; \
 167    isNegativeZero (T x) = isNegativeZero x ; \
 168    isIEEE         (T x) = isIEEE x ; \
 169    (T x) `atan2`  (T y) = T (x `atan2` y) }
 170
 171 #else /* __GLASGOW_HASKELL__ */
 172
 173 /* On GHC, we just cast the type of each method to the underlying
 174  * type.  This means that GHC only needs to generate the dictionary
 175  * for each instance, rather than a new function for each method (the
 176  * simplifier currently isn't clever enough to reduce a method that
 177  * simply deconstructs a newtype and calls the underlying method into
 178  * an indirection to the underlying method, so that's what we're doing
 179  * here).
 180  */
 181
 182 #define NUMERIC_TYPE(T,C,S,B) \
 183 newtype T = T B ; \
 184 INSTANCE_EQ(T,B) ; \
 185 INSTANCE_ORD(T,B) ; \
 186 INSTANCE_NUM(T,B) ; \
 187 INSTANCE_READ(T,B) ; \
 188 INSTANCE_SHOW(T,B) ; \
 189 INSTANCE_ENUM(T,B)
 190
 191 #define INTEGRAL_TYPE(T,C,S,B) \
 192 NUMERIC_TYPE(T,C,S,B) ;  \
 193 INSTANCE_BOUNDED(T,B) ; \
 194 INSTANCE_REAL(T,B) ; \
 195 INSTANCE_INTEGRAL(T,B) ; \
 196 INSTANCE_BITS(T,B)
 197
 198 #define FLOATING_TYPE(T,C,S,B) \
 199 NUMERIC_TYPE(T,C,S,B) ; \
 200 INSTANCE_REAL(T,B) ; \
 201 INSTANCE_FRACTIONAL(T,B) ; \
 202 INSTANCE_FLOATING(T,B) ; \
 203 INSTANCE_REALFRAC(T) ; \
 204 INSTANCE_REALFLOAT(T,B)
 205
 206 #define INSTANCE_EQ(T,B) \
 207 instance Eq T where { \
 208    (==)         = unsafeCoerce# ((==) :: B -> B -> Bool); \
 209    (/=)         = unsafeCoerce# ((/=) :: B -> B -> Bool); }
 210
 211 #define INSTANCE_ORD(T,B) \
 212 instance Ord T where { \
 213    compare              = unsafeCoerce# (compare :: B -> B -> Ordering); \
 214    (<)                  = unsafeCoerce# ((<) :: B -> B -> Bool); \
 215    (<=)                 = unsafeCoerce# ((<=) :: B -> B -> Bool); \
 216    (>=)                 = unsafeCoerce# ((>=) :: B -> B -> Bool); \
 217    (>)                  = unsafeCoerce# ((>) :: B -> B -> Bool); \
 218    max                  = unsafeCoerce# (max :: B -> B -> B); \
 219    min                  = unsafeCoerce# (min :: B -> B -> B); }
 220
 221 #define INSTANCE_READ(T,B) \
 222 instance Read T where { \
 223    readsPrec            = unsafeCoerce# (readsPrec :: Int -> ReadS B); \
 224    readList             = unsafeCoerce# (readList  :: ReadS [B]); }
 225
 226 #define INSTANCE_SHOW(T,B) \
 227 instance Show T where { \
 228    showsPrec            = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \
 229    show                 = unsafeCoerce# (show :: B -> String); \
 230    showList             = unsafeCoerce# (showList :: [B] -> ShowS); }
 231
 232 #define INSTANCE_NUM(T,B) \
 233 instance Num T where { \
 234    (+)                  = unsafeCoerce# ((+) :: B -> B -> B); \
 235    (-)                  = unsafeCoerce# ((-) :: B -> B -> B); \
 236    (*)                  = unsafeCoerce# ((*) :: B -> B -> B); \
 237    negate               = unsafeCoerce# (negate :: B -> B); \
 238    abs                  = unsafeCoerce# (abs :: B -> B); \
 239    signum               = unsafeCoerce# (signum :: B -> B); \
 240    fromInteger          = unsafeCoerce# (fromInteger :: Integer -> B); \
 241    fromInt              = unsafeCoerce# (fromInt :: Int -> B) }
 242
 243 #define INSTANCE_STORABLE(T,B) \
 244 instance Storable T where { \
 245    sizeOf  = unsafeCoerce# (sizeOf :: B -> Int); \
 246    alignment = unsafeCoerce# (alignment :: B -> Int); \
 247    peekElemOff = unsafeCoerce# (peekElemOff :: Ptr B -> Int -> IO B); \
 248    pokeElemOff = unsafeCoerce# (pokeElemOff :: Ptr B -> Int -> B -> IO B); }
 249
 250 #define INSTANCE_BOUNDED(T,B) \
 251 instance Bounded T where { \
 252    minBound = T minBound ; \
 253    maxBound = T maxBound }
 254
 255 #define INSTANCE_ENUM(T,B) \
 256 instance Enum T where { \
 257     succ                = unsafeCoerce# (succ :: B -> B); \
 258     pred                = unsafeCoerce# (pred :: B -> B); \
 259     toEnum              = unsafeCoerce# (toEnum :: Int -> B); \
 260     fromEnum            = unsafeCoerce# (fromEnum :: B -> Int); \
 261     enumFrom            = unsafeCoerce# (enumFrom :: B -> [B]); \
 262     enumFromThen        = unsafeCoerce# (enumFromThen :: B -> B -> [B]); \
 263     enumFromTo          = unsafeCoerce# (enumFromTo :: B -> B -> [B]); \
 264     enumFromThenTo      = unsafeCoerce# (enumFromThenTo :: B -> B -> B -> [B]);}
 265
 266 #define INSTANCE_REAL(T,B) \
 267 instance Real T where { \
 268    toRational = unsafeCoerce# (toRational :: B -> Rational) }
 269
 270 #define INSTANCE_INTEGRAL(T,B) \
 271 instance Integral T where { \
 272     quot                = unsafeCoerce# (quot:: B -> B -> B); \
 273     rem                 = unsafeCoerce# (rem:: B -> B -> B); \
 274     div                 = unsafeCoerce# (div:: B -> B -> B); \
 275     mod                 = unsafeCoerce# (mod:: B -> B -> B); \
 276     quotRem             = unsafeCoerce# (quotRem:: B -> B -> (B,B)); \
 277     divMod              = unsafeCoerce# (divMod:: B -> B -> (B,B)); \
 278     toInteger           = unsafeCoerce# (toInteger:: B -> Integer); \
 279     toInt               = unsafeCoerce# (toInt:: B -> Int); }
 280
 281 #define INSTANCE_BITS(T,B) \
 282 instance Bits T where { \
 283   (.&.)                 = unsafeCoerce# ((.&.) :: B -> B -> B); \
 284   (.|.)                 = unsafeCoerce# ((.|.) :: B -> B -> B); \
 285   xor                   = unsafeCoerce# (xor:: B -> B -> B); \
 286   complement            = unsafeCoerce# (complement:: B -> B); \
 287   shift                 = unsafeCoerce# (shift:: B -> Int -> B); \
 288   rotate                = unsafeCoerce# (rotate:: B -> Int -> B); \
 289   bit                   = unsafeCoerce# (bit:: Int -> B); \
 290   setBit                = unsafeCoerce# (setBit:: B -> Int -> B); \
 291   clearBit              = unsafeCoerce# (clearBit:: B -> Int -> B); \
 292   complementBit         = unsafeCoerce# (complementBit:: B -> Int -> B); \
 293   testBit               = unsafeCoerce# (testBit:: B -> Int -> Bool); \
 294   bitSize               = unsafeCoerce# (bitSize:: B -> Int); \
 295   isSigned              = unsafeCoerce# (isSigned:: B -> Bool); }
 296
 297 #define INSTANCE_FRACTIONAL(T,B) \
 298 instance Fractional T where { \
 299     (/)                 = unsafeCoerce# ((/) :: B -> B -> B); \
 300     recip               = unsafeCoerce# (recip :: B -> B); \
 301     fromRational        = unsafeCoerce# (fromRational :: Rational -> B); }
 302
 303 #define INSTANCE_FLOATING(T,B) \
 304 instance Floating T where { \
 305     pi                  = unsafeCoerce# (pi :: B); \
 306     exp                 = unsafeCoerce# (exp :: B -> B); \
 307     log                 = unsafeCoerce# (log :: B -> B); \
 308     sqrt                = unsafeCoerce# (sqrt :: B -> B); \
 309     (**)                = unsafeCoerce# ((**) :: B -> B -> B); \
 310     logBase             = unsafeCoerce# (logBase :: B -> B -> B); \
 311     sin                 = unsafeCoerce# (sin :: B -> B); \
 312     cos                 = unsafeCoerce# (cos :: B -> B); \
 313     tan                 = unsafeCoerce# (tan :: B -> B); \
 314     asin                = unsafeCoerce# (asin :: B -> B); \
 315     acos                = unsafeCoerce# (acos :: B -> B); \
 316     atan                = unsafeCoerce# (atan :: B -> B); \
 317     sinh                = unsafeCoerce# (sinh :: B -> B); \
 318     cosh                = unsafeCoerce# (cosh :: B -> B); \
 319     tanh                = unsafeCoerce# (tanh :: B -> B); \
 320     asinh               = unsafeCoerce# (asinh :: B -> B); \
 321     acosh               = unsafeCoerce# (acosh :: B -> B); \
 322     atanh               = unsafeCoerce# (atanh :: B -> B); }
 323
 324 /* The coerce trick doesn't work for RealFrac, these methods are
 325  * polymorphic and overloaded.
 326  */
 327 #define INSTANCE_REALFRAC(T) \
 328 instance RealFrac T where { \
 329    properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \
 330    truncate (T x) = truncate x ; \
 331    round    (T x) = round x ; \
 332    ceiling  (T x) = ceiling x ; \
 333    floor    (T x) = floor x }
 334
 335 #define INSTANCE_REALFLOAT(T,B) \
 336 instance RealFloat T where { \
 337     floatRadix          = unsafeCoerce# (floatRadix :: B -> Integer); \
 338     floatDigits         = unsafeCoerce# (floatDigits :: B -> Int); \
 339     floatRange          = unsafeCoerce# (floatRange :: B -> (Int,Int)); \
 340     decodeFloat         = unsafeCoerce# (decodeFloat :: B -> (Integer,Int)); \
 341     encodeFloat         = unsafeCoerce# (encodeFloat :: Integer -> Int -> B); \
 342     exponent            = unsafeCoerce# (exponent :: B -> Int); \
 343     significand         = unsafeCoerce# (significand :: B -> B); \
 344     scaleFloat          = unsafeCoerce# (scaleFloat :: Int -> B -> B); \
 345     isNaN               = unsafeCoerce# (isNaN :: B -> Bool); \
 346     isInfinite          = unsafeCoerce# (isInfinite :: B -> Bool); \
 347     isDenormalized      = unsafeCoerce# (isDenormalized :: B -> Bool); \
 348     isNegativeZero      = unsafeCoerce# (isNegativeZero :: B -> Bool); \
 349     isIEEE              = unsafeCoerce# (isIEEE :: B -> Bool); \
 350     atan2               = unsafeCoerce# (atan2 :: B -> B -> B); }
 351
 352 #endif /* __GLASGOW_HASKELL__ */