6 #include "cln/number.h"
11 extern cl_class cl_class_bignum;
12 extern cl_class cl_class_ratio;
13 extern cl_class cl_class_ffloat;
14 extern cl_class cl_class_dfloat;
15 extern cl_class cl_class_lfloat;
18 inline bool rationalp (const cl_R& x)
21 if (x.nonpointer_tag() == cl_FN_tag)
24 if (x.pointer_type()->flags & cl_class_flags_subclass_rational)
29 inline bool integerp (const cl_R& x)
32 if (x.nonpointer_tag() == cl_FN_tag)
35 if (x.pointer_type() == &cl_class_bignum)
40 inline bool floatp (const cl_R& x)
43 switch (x.nonpointer_tag()) {
45 #if defined(CL_WIDE_POINTERS)
51 if (x.pointer_type()->flags & cl_class_flags_subclass_float)
57 // Comparison with a fixnum.
58 inline bool eq (const cl_R& x, sint32 y)
60 return x.word == cl_combine(cl_FN_tag,y);
63 inline bool exact_zerop (const cl_R& x)
69 // Macro: verteilt je nach Real-Typ eines Floats x auf 2 Statements,
70 // die x vom jeweiligen Real-Typ benutzen dürfen.
71 // realcase2(x, RA_statement,F_statement);
72 // x sollte eine Variable sein.
73 #define realcase2(x, RA_statement,F_statement) \
75 { var cl_RA& __tmp = *(cl_RA*)&x; var cl_RA& x = __tmp; RA_statement } \
77 { var cl_F& __tmp = *(cl_F*)&x; var cl_F& x = __tmp; F_statement }
79 // Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements.
80 // realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
81 // x sollte eine Variable sein.
82 #ifdef CL_WIDE_POINTERS
83 #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
84 if (!(x).pointer_p()) \
85 switch ((x).nonpointer_tag()) \
86 { case cl_FN_tag: { FN_statement } break; \
87 case cl_SF_tag: { SF_statement } break; \
88 case cl_FF_tag: { FF_statement } break; \
92 if ((x).pointer_type() == &cl_class_bignum) { BN_statement } \
93 else if ((x).pointer_type() == &cl_class_ratio) { RT_statement } \
94 else if ((x).pointer_type() == &cl_class_dfloat) { DF_statement } \
95 else if ((x).pointer_type() == &cl_class_lfloat) { LF_statement } \
99 #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
100 if (!(x).pointer_p()) \
101 switch ((x).nonpointer_tag()) \
102 { case cl_FN_tag: { FN_statement } break; \
103 case cl_SF_tag: { SF_statement } break; \
104 default: NOTREACHED \
107 if ((x).pointer_type() == &cl_class_bignum) { BN_statement } \
108 else if ((x).pointer_type() == &cl_class_ratio) { RT_statement } \
109 else if ((x).pointer_type() == &cl_class_ffloat) { FF_statement } \
110 else if ((x).pointer_type() == &cl_class_dfloat) { DF_statement } \
111 else if ((x).pointer_type() == &cl_class_lfloat) { LF_statement } \
116 // Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements,
117 // die x vom jeweiligen Real-Typ benutzen dürfen.
118 // realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
119 // x sollte eine Variable sein.
120 #define realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
122 , var cl_FN& __tmp = *(cl_FN*)&x; var cl_FN& x = __tmp; FN_statement \
123 , var cl_BN& __tmp = *(cl_BN*)&x; var cl_BN& x = __tmp; BN_statement \
124 , var cl_RT& __tmp = *(cl_RT*)&x; var cl_RT& x = __tmp; RT_statement \
125 , var cl_SF& __tmp = *(cl_SF*)&x; var cl_SF& x = __tmp; SF_statement \
126 , var cl_FF& __tmp = *(cl_FF*)&x; var cl_FF& x = __tmp; FF_statement \
127 , var cl_DF& __tmp = *(cl_DF*)&x; var cl_DF& x = __tmp; DF_statement \
128 , var cl_LF& __tmp = *(cl_LF*)&x; var cl_LF& x = __tmp; LF_statement \
131 // Macro: verteilt je nach Real-Typ eines Floats x auf 6 Statements,
132 // die x vom jeweiligen Real-Typ benutzen dürfen.
133 // realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
134 // x sollte eine Variable sein.
135 #define realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
136 realcase7(x, I_statement,I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement)
138 // contagion(x,y) liefert eine reelle Zahl, die so ungenau ist wie die
139 // ungenauere der beiden reellen Zahlen x und y.
140 extern const cl_R contagion (const cl_R& x, const cl_R& y);
141 // ?? Lieber ein uintL (0, SF_mant_len+1, FF_mant_len+1, DF_mant_len+1, intDsize*len liefern, weniger Kopieraufwand!
143 // GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung)
144 // generates the body of a real operation with one argument.
145 // Distinguish two cases (rational/float) only.
146 #define GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung) \
149 , ergebnis_zuweisung R_OP(arg1); \
150 , ergebnis_zuweisung R_OP(arg1); \
154 // GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung)
155 // generates the body of a real operation with one argument.
156 // Full type dispatch, faster than GEN_R_OP1_2.
157 #define GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung) \
160 , ergebnis_zuweisung R_OP(arg1); \
161 , ergebnis_zuweisung R_OP(arg1); \
162 , ergebnis_zuweisung R_OP(arg1); \
163 , ergebnis_zuweisung R_OP(arg1); \
164 , ergebnis_zuweisung R_OP(arg1); \
165 , ergebnis_zuweisung R_OP(arg1); \
166 , ergebnis_zuweisung R_OP(arg1); \
170 // GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung)
171 // generates the body of a real operation with two arguments.
172 // Distinguish two cases (rational/float) only.
173 #define GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung) \
177 , /* beides rationale Zahlen */ \
178 ergebnis_zuweisung R_OP(arg1,arg2); \
179 , /* arg1 rational, arg2 Float -> arg1 in Float umwandeln */ \
180 ergebnis_zuweisung R_OP(cl_float(arg1,arg2),arg2); \
183 , /* arg1 Float, arg2 rational -> arg2 in Float umwandeln */ \
184 ergebnis_zuweisung R_OP(arg1,cl_float(arg2,arg1)); \
185 , /* beides Floats */ \
186 ergebnis_zuweisung R_OP(arg1,arg2); \
191 // cl_somefloat(x,y) wandelt eine reelle Zahl x in ein Float-Format um
192 // (das von y, falls x rational ist) und rundet dabei nötigenfalls.
193 // > x: eine reelle Zahl
195 // < ergebnis: x als Float
196 inline const cl_F cl_somefloat (const cl_R& x, const cl_F& y)
199 DeclareType(cl_RA,x);
200 return cl_float(x,y);