64abde9afe409a2950c9f66b2c7eb959bc4deffb
[packages/old-time.git] / include / CTypes.h
1 /* -----------------------------------------------------------------------------
2 * $Id: CTypes.h,v 1.4 2002/08/20 10:03:05 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_TYPEABLE0(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 #ifndef __GLASGOW_HASKELL__
42 #define fakeMap map
43 #endif
44
45 #define INSTANCE_READ(T) \
46 instance Read T where { \
47 readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) }
48
49 #define INSTANCE_SHOW(T) \
50 instance Show T where { \
51 showsPrec p (T x) = showsPrec p x }
52
53 #define INSTANCE_NUM(T) \
54 instance Num T where { \
55 (T i) + (T j) = T (i + j) ; \
56 (T i) - (T j) = T (i - j) ; \
57 (T i) * (T j) = T (i * j) ; \
58 negate (T i) = T (negate i) ; \
59 abs (T i) = T (abs i) ; \
60 signum (T i) = T (signum i) ; \
61 fromInteger x = T (fromInteger x) }
62
63 #define INSTANCE_BOUNDED(T) \
64 instance Bounded T where { \
65 minBound = T minBound ; \
66 maxBound = T maxBound }
67
68 #define INSTANCE_ENUM(T) \
69 instance Enum T where { \
70 succ (T i) = T (succ i) ; \
71 pred (T i) = T (pred i) ; \
72 toEnum x = T (toEnum x) ; \
73 fromEnum (T i) = fromEnum i ; \
74 enumFrom (T i) = fakeMap T (enumFrom i) ; \
75 enumFromThen (T i) (T j) = fakeMap T (enumFromThen i j) ; \
76 enumFromTo (T i) (T j) = fakeMap T (enumFromTo i j) ; \
77 enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) }
78
79 #define INSTANCE_REAL(T) \
80 instance Real T where { \
81 toRational (T i) = toRational i }
82
83 #define INSTANCE_INTEGRAL(T) \
84 instance Integral T where { \
85 (T i) `quot` (T j) = T (i `quot` j) ; \
86 (T i) `rem` (T j) = T (i `rem` j) ; \
87 (T i) `div` (T j) = T (i `div` j) ; \
88 (T i) `mod` (T j) = T (i `mod` j) ; \
89 (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \
90 (T i) `divMod` (T j) = let (d,m) = i `divMod` j in (T d, T m) ; \
91 toInteger (T i) = toInteger i }
92
93 #define INSTANCE_BITS(T) \
94 instance Bits T where { \
95 (T x) .&. (T y) = T (x .&. y) ; \
96 (T x) .|. (T y) = T (x .|. y) ; \
97 (T x) `xor` (T y) = T (x `xor` y) ; \
98 complement (T x) = T (complement x) ; \
99 shift (T x) n = T (shift x n) ; \
100 rotate (T x) n = T (rotate x n) ; \
101 bit n = T (bit n) ; \
102 setBit (T x) n = T (setBit x n) ; \
103 clearBit (T x) n = T (clearBit x n) ; \
104 complementBit (T x) n = T (complementBit x n) ; \
105 testBit (T x) n = testBit x n ; \
106 bitSize (T x) = bitSize x ; \
107 isSigned (T x) = isSigned x }
108
109 #define INSTANCE_FRACTIONAL(T) \
110 instance Fractional T where { \
111 (T x) / (T y) = T (x / y) ; \
112 recip (T x) = T (recip x) ; \
113 fromRational r = T (fromRational r) }
114
115 #define INSTANCE_FLOATING(T) \
116 instance Floating T where { \
117 pi = pi ; \
118 exp (T x) = T (exp x) ; \
119 log (T x) = T (log x) ; \
120 sqrt (T x) = T (sqrt x) ; \
121 (T x) ** (T y) = T (x ** y) ; \
122 (T x) `logBase` (T y) = T (x `logBase` y) ; \
123 sin (T x) = T (sin x) ; \
124 cos (T x) = T (cos x) ; \
125 tan (T x) = T (tan x) ; \
126 asin (T x) = T (asin x) ; \
127 acos (T x) = T (acos x) ; \
128 atan (T x) = T (atan x) ; \
129 sinh (T x) = T (sinh x) ; \
130 cosh (T x) = T (cosh x) ; \
131 tanh (T x) = T (tanh x) ; \
132 asinh (T x) = T (asinh x) ; \
133 acosh (T x) = T (acosh x) ; \
134 atanh (T x) = T (atanh x) }
135
136 #define INSTANCE_REALFRAC(T) \
137 instance RealFrac T where { \
138 properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \
139 truncate (T x) = truncate x ; \
140 round (T x) = round x ; \
141 ceiling (T x) = ceiling x ; \
142 floor (T x) = floor x }
143
144 #define INSTANCE_REALFLOAT(T) \
145 instance RealFloat T where { \
146 floatRadix (T x) = floatRadix x ; \
147 floatDigits (T x) = floatDigits x ; \
148 floatRange (T x) = floatRange x ; \
149 decodeFloat (T x) = decodeFloat x ; \
150 encodeFloat m n = T (encodeFloat m n) ; \
151 exponent (T x) = exponent x ; \
152 significand (T x) = T (significand x) ; \
153 scaleFloat n (T x) = T (scaleFloat n x) ; \
154 isNaN (T x) = isNaN x ; \
155 isInfinite (T x) = isInfinite x ; \
156 isDenormalized (T x) = isDenormalized x ; \
157 isNegativeZero (T x) = isNegativeZero x ; \
158 isIEEE (T x) = isIEEE x ; \
159 (T x) `atan2` (T y) = T (x `atan2` y) }
160
161 #else /* __GLASGOW_HASKELL__ */
162
163 /* GHC can derive any class for a newtype, so we make use of that
164 * here...
165 */
166
167 #define NUMERIC_CLASSES Eq,Ord,Num,Enum
168 #define INTEGRAL_CLASSES Bounded,Real,Integral,Bits
169 #define FLOATING_CLASSES Real,Fractional,Floating,RealFrac,RealFloat
170
171 #define NUMERIC_TYPE(T,C,S,B) \
172 newtype T = T B deriving (NUMERIC_CLASSES); \
173 INSTANCE_READ(T,B); \
174 INSTANCE_SHOW(T,B); \
175 INSTANCE_TYPEABLE0(T,C,S) ;
176
177 #define INTEGRAL_TYPE(T,C,S,B) \
178 newtype T = T B deriving (NUMERIC_CLASSES, INTEGRAL_CLASSES); \
179 INSTANCE_READ(T,B); \
180 INSTANCE_SHOW(T,B); \
181 INSTANCE_TYPEABLE0(T,C,S) ;
182
183 #define FLOATING_TYPE(T,C,S,B) \
184 newtype T = T B deriving (NUMERIC_CLASSES, FLOATING_CLASSES); \
185 INSTANCE_READ(T,B); \
186 INSTANCE_SHOW(T,B); \
187 INSTANCE_TYPEABLE0(T,C,S) ;
188
189 #define INSTANCE_READ(T,B) \
190 instance Read T where { \
191 readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \
192 readList = unsafeCoerce# (readList :: ReadS [B]); }
193
194 #define INSTANCE_SHOW(T,B) \
195 instance Show T where { \
196 showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \
197 show = unsafeCoerce# (show :: B -> String); \
198 showList = unsafeCoerce# (showList :: [B] -> ShowS); }
199
200 #endif /* __GLASGOW_HASKELL__ */