src/real/cl_R.h

   1 // cl_R internals
   2
   3 #ifndef _CL_R_H
   4 #define _CL_R_H
   5
   6 #include "cl_number.h"
   7 #include "cl_real.h"
   8
   9 extern cl_class cl_class_bignum;
  10 extern cl_class cl_class_ratio;
  11 extern cl_class cl_class_ffloat;
  12 extern cl_class cl_class_dfloat;
  13 extern cl_class cl_class_lfloat;
  14
  15 // Type tests.
  16 inline cl_boolean rationalp (const cl_R& x)
  17 {
  18         if (!x.pointer_p()) {
  19                 if (x.nonpointer_tag() == cl_FN_tag)
  20                         return cl_true;
  21         } else {
  22                 if (x.pointer_type()->flags & cl_class_flags_subclass_rational)
  23                         return cl_true;
  24         }
  25         return cl_false;
  26 }
  27 inline cl_boolean integerp (const cl_R& x)
  28 {
  29         if (!x.pointer_p()) {
  30                 if (x.nonpointer_tag() == cl_FN_tag)
  31                         return cl_true;
  32         } else {
  33                 if (x.pointer_type() == &cl_class_bignum)
  34                         return cl_true;
  35         }
  36         return cl_false;
  37 }
  38 inline cl_boolean floatp (const cl_R& x)
  39 {
  40         if (!x.pointer_p()) {
  41                 switch (x.nonpointer_tag()) {
  42                 case cl_SF_tag:
  43                 #if defined(CL_WIDE_POINTERS)
  44                 case cl_FF_tag:
  45                 #endif
  46                         return cl_true;
  47                 }
  48         } else {
  49                 if (x.pointer_type()->flags & cl_class_flags_subclass_float)
  50                         return cl_true;
  51         }
  52         return cl_false;
  53 }
  54
  55 // Comparison with a fixnum.
  56 inline cl_boolean eq (const cl_R& x, sint32 y)
  57 {
  58         return (cl_boolean)(x.word == cl_combine(cl_FN_tag,y));
  59 }
  60
  61 inline cl_boolean exact_zerop (const cl_R& x)
  62 {
  63         return eq(x,0);
  64 }
  65
  66
  67 // Macro: verteilt je nach Real-Typ eines Floats x auf 2 Statements,
  68 // die x vom jeweiligen Real-Typ benutzen dürfen.
  69 // realcase2(x, RA_statement,F_statement);
  70 // x sollte eine Variable sein.
  71   #define realcase2(x, RA_statement,F_statement) \
  72     if (rationalp(x))                                                        \
  73       { var cl_RA& __tmp = *(cl_RA*)&x; var cl_RA& x = __tmp; RA_statement } \
  74     else                                                                     \
  75       { var cl_F& __tmp = *(cl_F*)&x; var cl_F& x = __tmp; F_statement }
  76
  77 // Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements.
  78 // realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
  79 // x sollte eine Variable sein.
  80 #ifdef CL_WIDE_POINTERS
  81   #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
  82     if (!(x).pointer_p())                                               \
  83       switch ((x).nonpointer_tag())                                     \
  84         { case cl_FN_tag: { FN_statement } break;                       \
  85           case cl_SF_tag: { SF_statement } break;                       \
  86           case cl_FF_tag: { FF_statement } break;                       \
  87           default: NOTREACHED                                           \
  88         }                                                               \
  89       else {                                                            \
  90         if ((x).pointer_type() == &cl_class_bignum) { BN_statement }    \
  91         else if ((x).pointer_type() == &cl_class_ratio) { RT_statement } \
  92         else if ((x).pointer_type() == &cl_class_dfloat) { DF_statement } \
  93         else if ((x).pointer_type() == &cl_class_lfloat) { LF_statement } \
  94         else NOTREACHED                                                 \
  95       }
  96 #else
  97   #define realtypecase(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
  98     if (!(x).pointer_p())                                               \
  99       switch ((x).nonpointer_tag())                                     \
 100         { case cl_FN_tag: { FN_statement } break;                       \
 101           case cl_SF_tag: { SF_statement } break;                       \
 102           default: NOTREACHED                                           \
 103         }                                                               \
 104       else {                                                            \
 105         if ((x).pointer_type() == &cl_class_bignum) { BN_statement }    \
 106         else if ((x).pointer_type() == &cl_class_ratio) { RT_statement } \
 107         else if ((x).pointer_type() == &cl_class_ffloat) { FF_statement } \
 108         else if ((x).pointer_type() == &cl_class_dfloat) { DF_statement } \
 109         else if ((x).pointer_type() == &cl_class_lfloat) { LF_statement } \
 110         else NOTREACHED                                                 \
 111       }
 112 #endif
 113
 114 // Macro: verteilt je nach Real-Typ eines Floats x auf 7 Statements,
 115 // die x vom jeweiligen Real-Typ benutzen dürfen.
 116 // realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
 117 // x sollte eine Variable sein.
 118   #define realcase7(x, FN_statement,BN_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
 119     realtypecase(x                                                         \
 120       , var cl_FN& __tmp = *(cl_FN*)&x; var cl_FN& x = __tmp; FN_statement \
 121       , var cl_BN& __tmp = *(cl_BN*)&x; var cl_BN& x = __tmp; BN_statement \
 122       , var cl_RT& __tmp = *(cl_RT*)&x; var cl_RT& x = __tmp; RT_statement \
 123       , var cl_SF& __tmp = *(cl_SF*)&x; var cl_SF& x = __tmp; SF_statement \
 124       , var cl_FF& __tmp = *(cl_FF*)&x; var cl_FF& x = __tmp; FF_statement \
 125       , var cl_DF& __tmp = *(cl_DF*)&x; var cl_DF& x = __tmp; DF_statement \
 126       , var cl_LF& __tmp = *(cl_LF*)&x; var cl_LF& x = __tmp; LF_statement \
 127       )
 128
 129 // Macro: verteilt je nach Real-Typ eines Floats x auf 6 Statements,
 130 // die x vom jeweiligen Real-Typ benutzen dürfen.
 131 // realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement);
 132 // x sollte eine Variable sein.
 133   #define realcase6(x, I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement) \
 134     realcase7(x, I_statement,I_statement,RT_statement,SF_statement,FF_statement,DF_statement,LF_statement)
 135
 136 // contagion(x,y) liefert eine reelle Zahl, die so ungenau ist wie die
 137 // ungenauere der beiden reellen Zahlen x und y.
 138 extern const cl_R contagion (const cl_R& x, const cl_R& y);
 139 // ?? Lieber ein uintL (0, SF_mant_len+1, FF_mant_len+1, DF_mant_len+1, intDsize*len liefern, weniger Kopieraufwand!
 140
 141 // GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung)
 142 // generates the body of a real operation with one argument.
 143 // Distinguish two cases (rational/float) only.
 144 #define GEN_R_OP1_2(arg1,R_OP,ergebnis_zuweisung)  \
 145 {                                                                       \
 146         realcase2(arg1                                                  \
 147         , ergebnis_zuweisung R_OP(arg1);                                \
 148         , ergebnis_zuweisung R_OP(arg1);                                \
 149         );                                                              \
 150 }
 151
 152 // GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung)
 153 // generates the body of a real operation with one argument.
 154 // Full type dispatch, faster than GEN_R_OP1_2.
 155 #define GEN_R_OP1_7(arg1,R_OP,ergebnis_zuweisung)  \
 156 {                                                                       \
 157         realcase7(arg1                                                  \
 158         , ergebnis_zuweisung R_OP(arg1);                                \
 159         , ergebnis_zuweisung R_OP(arg1);                                \
 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         );                                                              \
 166 }
 167
 168 // GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung)
 169 // generates the body of a real operation with two arguments.
 170 // Distinguish two cases (rational/float) only.
 171 #define GEN_R_OP2_2(arg1,arg2,R_OP,ergebnis_zuweisung)  \
 172 {                                                                       \
 173         realcase2(arg1                                                  \
 174         ,       realcase2(arg2                                          \
 175                 ,       /* beides rationale Zahlen */                   \
 176                         ergebnis_zuweisung R_OP(arg1,arg2);             \
 177                 ,       /* arg1 rational, arg2 Float -> arg1 in Float umwandeln */ \
 178                         ergebnis_zuweisung R_OP(cl_float(arg1,arg2),arg2); \
 179                 );                                                      \
 180         ,       realcase2(arg2                                          \
 181                 ,       /* arg1 Float, arg2 rational -> arg2 in Float umwandeln */ \
 182                         ergebnis_zuweisung R_OP(arg1,cl_float(arg2,arg1)); \
 183                 ,       /* beides Floats */                             \
 184                         ergebnis_zuweisung R_OP(arg1,arg2);             \
 185                 );                                                      \
 186         );                                                              \
 187 }
 188
 189 // cl_somefloat(x,y) wandelt eine reelle Zahl x in ein Float-Format um
 190 // (das von y, falls x rational ist) und rundet dabei nötigenfalls.
 191 // > x: eine reelle Zahl
 192 // > y: ein Float
 193 // < ergebnis: x als Float
 194 inline const cl_F cl_somefloat (const cl_R& x, const cl_F& y)
 195 {
 196         if (rationalp(x)) {
 197                 DeclareType(cl_RA,x);
 198                 return cl_float(x,y);
 199         } else {
 200                 DeclareType(cl_F,x);
 201                 return x;
 202         }
 203 }
 204
 205 #endif /* _CL_R_H */