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