src/cpfront/generic/System/Mod/Math.cp

   1 MODULE Math;
   2
   3   IMPORT SYSTEM;
   4
   5   VAR
   6     eps, e: REAL;
   7
   8   PROCEDURE [code] IncludeMATH "#include <math.h>";
   9   PROCEDURE [code] M_PI (): REAL "M_PI";
  10   PROCEDURE [code] sqrt (x: REAL): REAL "sqrt(x)";
  11   PROCEDURE [code] exp (x: REAL): REAL "exp(x)";
  12   PROCEDURE [code] log (x: REAL): REAL "log(x)";
  13   PROCEDURE [code] log10 (x: REAL): REAL "log10(x)";
  14   PROCEDURE [code] pow (x, y: REAL): REAL "pow(x, y)";
  15   PROCEDURE [code] sin (x: REAL): REAL "sin(x)";
  16   PROCEDURE [code] cos (x: REAL): REAL "cos(x)";
  17   PROCEDURE [code] tan (x: REAL): REAL "tan(x)";
  18   PROCEDURE [code] asin (x: REAL): REAL "asin(x)";
  19   PROCEDURE [code] acos (x: REAL): REAL "acos(x)";
  20   PROCEDURE [code] atan (x: REAL): REAL "atan(x)";
  21   PROCEDURE [code] atan2 (y, x: REAL): REAL "atan2(y, x)";
  22   PROCEDURE [code] sinh (x: REAL): REAL "sinh(x)";
  23   PROCEDURE [code] cosh (x: REAL): REAL "cosh(x)";
  24   PROCEDURE [code] tanh (x: REAL): REAL "tanh(x)";
  25   PROCEDURE [code] asinh (x: REAL): REAL "asinh(x)";
  26   PROCEDURE [code] acosh (x: REAL): REAL "acosh(x)";
  27   PROCEDURE [code] atanh (x: REAL): REAL "atanh(x)";
  28   PROCEDURE [code] floor (x: REAL): REAL "floor(x)";
  29   PROCEDURE [code] ceil (x: REAL): REAL "ceil(x)";
  30   PROCEDURE [code] round (x: REAL): REAL "round(x)";
  31   PROCEDURE [code] trunc (x: REAL): REAL "trunc(x)";
  32   PROCEDURE [code] copysign (x, y: REAL): REAL "copysign(x, y)";
  33   PROCEDURE [code] frexp (x: REAL; OUT exp: INTEGER): REAL "frexp(x, exp)";
  34   PROCEDURE [code] ldexp (x: REAL; exp: INTEGER): REAL "ldexp(x, exp)";
  35
  36   PROCEDURE Pi* (): REAL;
  37   BEGIN
  38     RETURN M_PI()
  39   END Pi;
  40
  41   PROCEDURE Eps* (): REAL;
  42   BEGIN
  43     RETURN eps
  44   END Eps;
  45
  46   PROCEDURE Sqrt* (x: REAL): REAL;
  47   BEGIN
  48     RETURN sqrt(x)
  49   END Sqrt;
  50
  51   PROCEDURE Exp* (x: REAL): REAL;
  52   BEGIN
  53     RETURN exp(x)
  54   END Exp;
  55
  56   PROCEDURE Ln* (x: REAL): REAL;
  57   BEGIN
  58     RETURN log(x)
  59   END Ln;
  60
  61   PROCEDURE Log* (x: REAL): REAL;
  62   BEGIN
  63     RETURN log10(x)
  64   END Log;
  65
  66   PROCEDURE Power* (x, y: REAL): REAL;
  67   BEGIN
  68     RETURN pow(x, y)
  69   END Power;
  70
  71   PROCEDURE IntPower* (x: REAL; n: INTEGER): REAL;
  72     VAR y: REAL;
  73   BEGIN
  74     IF n = MIN(INTEGER) THEN RETURN IntPower(x, n + 1) / x END;
  75     y := 1.0;
  76     IF n < 0 THEN x := 1.0 / x; n := -n END;
  77     WHILE n > 0 DO
  78       IF ODD(n) THEN y := y * x; DEC(n)
  79       ELSE x := x * x; n := n DIV 2
  80       END
  81     END;
  82     RETURN y
  83   END IntPower;
  84
  85   PROCEDURE Sin* (x: REAL): REAL;
  86   BEGIN
  87     RETURN sin(x)
  88   END Sin;
  89
  90   PROCEDURE Cos* (x: REAL): REAL;
  91   BEGIN
  92     RETURN cos(x)
  93   END Cos;
  94
  95   PROCEDURE Tan* (x: REAL): REAL;
  96   BEGIN
  97     RETURN tan(x)
  98   END Tan;
  99
 100   PROCEDURE SinCos* (x: REAL; OUT s, c: REAL);
 101   BEGIN
 102     s := sin(x); c := cos(x)
 103   END SinCos;
 104
 105   PROCEDURE ArcSin* (x: REAL): REAL;
 106   BEGIN
 107     RETURN asin(x)
 108   END ArcSin;
 109
 110   PROCEDURE ArcCos* (x: REAL): REAL;
 111   BEGIN
 112     RETURN acos(x)
 113   END ArcCos;
 114
 115   PROCEDURE ArcTan* (x: REAL): REAL;
 116   BEGIN
 117     RETURN atan(x)
 118   END ArcTan;
 119
 120   PROCEDURE ArcTan2* (y, x: REAL): REAL;
 121   BEGIN
 122     RETURN atan2(y, x)
 123   END ArcTan2;
 124
 125   PROCEDURE Sinh* (x: REAL): REAL;
 126   BEGIN
 127     RETURN sinh(x)
 128   END Sinh;
 129
 130   PROCEDURE Cosh* (x: REAL): REAL;
 131   BEGIN
 132     RETURN cosh(x)
 133   END Cosh;
 134
 135   PROCEDURE Tanh* (x: REAL): REAL;
 136   BEGIN
 137     RETURN tanh(x)
 138   END Tanh;
 139
 140   PROCEDURE ArcSinh* (x: REAL): REAL;
 141   BEGIN
 142     RETURN asinh(x)
 143   END ArcSinh;
 144
 145   PROCEDURE ArcCosh* (x: REAL): REAL;
 146   BEGIN
 147     RETURN acosh(x)
 148   END ArcCosh;
 149
 150   PROCEDURE ArcTanh* (x: REAL): REAL;
 151   BEGIN
 152     RETURN atanh(x)
 153   END ArcTanh;
 154
 155   PROCEDURE Floor* (x: REAL): REAL;
 156   BEGIN
 157     RETURN floor(x)
 158   END Floor;
 159
 160   PROCEDURE Ceiling* (x: REAL): REAL;
 161   BEGIN
 162     RETURN ceil(x)
 163   END Ceiling;
 164
 165   PROCEDURE Round* (x: REAL): REAL;
 166   BEGIN
 167     RETURN round(x)
 168   END Round;
 169
 170   PROCEDURE Trunc* (x: REAL): REAL;
 171   BEGIN
 172     RETURN trunc(x)
 173   END Trunc;
 174
 175   PROCEDURE Frac* (x: REAL): REAL;
 176   BEGIN
 177     IF x >= 0 THEN RETURN x - ENTIER(x)
 178     ELSE RETURN x + ENTIER(-x)
 179     END
 180   END Frac;
 181
 182   PROCEDURE Mod1* (x: REAL): REAL;
 183   BEGIN
 184     RETURN x - ENTIER(x)
 185   END Mod1;
 186
 187   PROCEDURE Sign* (x: REAL): REAL;
 188   BEGIN
 189     IF x > 0 THEN RETURN 1
 190     ELSIF x < 0 THEN RETURN -1
 191     ELSE RETURN x
 192     END
 193   END Sign;
 194
 195   PROCEDURE SignBit* (x: REAL): BOOLEAN;
 196   BEGIN
 197     RETURN copysign(1.0, x) > 0
 198   END SignBit;
 199
 200   PROCEDURE CopySign* (x, y: REAL): REAL;
 201   BEGIN
 202     RETURN copysign(x, y)
 203   END CopySign;
 204
 205   PROCEDURE Mantissa* (x: REAL): REAL;
 206     VAR e: INTEGER;
 207   BEGIN
 208     RETURN frexp(x, e);
 209   END Mantissa;
 210
 211   PROCEDURE Exponent* (x: REAL): INTEGER;
 212     VAR m: REAL; e: INTEGER;
 213   BEGIN
 214     m := frexp(x, e);
 215     RETURN e
 216   END Exponent;
 217
 218   PROCEDURE Real* (m: REAL; e: INTEGER): REAL;
 219   BEGIN
 220     RETURN ldexp(m, e)
 221   END Real;
 222
 223 BEGIN
 224   eps := 1.0E+0;
 225   e := 2.0E+0;
 226   WHILE e > 1.0E+0 DO
 227     eps := eps/2.0E+0;
 228     e := 1.0E+0 + eps
 229   END;
 230   eps := 2.0E+0 * eps
 231 END Math.