gcc/ada/urealp.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               U R E A L P                                --
   6 --                                                                          --
   7 --                                 S p e c                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2023, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 --  Support for universal real arithmetic
  27
  28 --  WARNING: There is a C version of this package. Any changes to this
  29 --  source file must be properly reflected in the C header file urealp.h
  30
  31 with Types; use Types;
  32 with Uintp; use Uintp;
  33
  34 package Urealp is
  35
  36    ---------------------------------------
  37    -- Representation of Universal Reals --
  38    ---------------------------------------
  39
  40    --  A universal real value is represented by a single value (which is
  41    --  an index into an internal table). These values are not hashed, so
  42    --  the equality operator should not be used on Ureal values (instead
  43    --  use the UR_Eq function).
  44
  45    --  A Ureal value represents an arbitrary precision universal real value,
  46    --  stored internally using four components:
  47
  48    --    the numerator (Uint, always non-negative)
  49    --    the denominator (Uint, always non-zero, always positive if base = 0)
  50    --    a real base (Nat, either zero, or in the range 2 .. 16)
  51    --    a sign flag (Boolean), set if negative
  52
  53    --  Negative numbers are represented by the sign flag being True.
  54
  55    --  If the base is zero, then the absolute value of the Ureal is simply
  56    --  numerator/denominator, where denominator is positive. If the base is
  57    --  non-zero, then the absolute value is numerator / (base ** denominator).
  58    --  In that case, since base is positive, (base ** denominator) is also
  59    --  positive, even when denominator is negative or null.
  60
  61    --  A normalized Ureal value has base = 0, and numerator/denominator
  62    --  reduced to lowest terms, with zero itself being represented as 0/1.
  63    --  This is a canonical format, so that for normalized Ureal values it
  64    --  is the case that two equal values always have the same denominator
  65    --  and numerator values.
  66
  67    --  Note: a value of minus zero is legitimate, and the operations in
  68    --  Urealp preserve the handling of signed zeroes in accordance with
  69    --  the rules of IEEE P754 ("IEEE floating point").
  70
  71    ------------------------------
  72    -- Types for Urealp Package --
  73    ------------------------------
  74
  75    type Ureal is private;
  76    --  Type used for representation of universal reals
  77
  78    No_Ureal : constant Ureal;
  79    --  Constant used to indicate missing or unset Ureal value
  80
  81    ---------------------
  82    -- Ureal Constants --
  83    ---------------------
  84
  85    function Ureal_0 return Ureal;
  86    --  Returns value 0.0
  87
  88    function Ureal_M_0 return Ureal;
  89    --  Returns value -0.0
  90
  91    function Ureal_Tenth return Ureal;
  92    --  Returns value 0.1
  93
  94    function Ureal_Half return Ureal;
  95    --  Returns value 0.5
  96
  97    function Ureal_1 return Ureal;
  98    --  Returns value 1.0
  99
 100    function Ureal_2 return Ureal;
 101    --  Returns value 2.0
 102
 103    function Ureal_10 return Ureal;
 104    --  Returns value 10.0
 105
 106    function Ureal_100 return Ureal;
 107    --  Returns value 100.0
 108
 109    function Ureal_2_31 return Ureal;
 110    --  Returns value 2.0 ** 31
 111
 112    function Ureal_2_63 return Ureal;
 113    --  Returns value 2.0 ** 63
 114
 115    function Ureal_2_80 return Ureal;
 116    --  Returns value 2.0 ** 80
 117
 118    function Ureal_2_M_80 return Ureal;
 119    --  Returns value 2.0 ** (-80)
 120
 121    function Ureal_2_127 return Ureal;
 122    --  Returns value 2.0 ** 127
 123
 124    function Ureal_2_M_127 return Ureal;
 125    --  Returns value 2.0 ** (-127)
 126
 127    function Ureal_2_128 return Ureal;
 128    --  Returns value 2.0 ** 128
 129
 130    function Ureal_2_M_128 return Ureal;
 131    --  Returns value 2.0 ** (-128)
 132
 133    function Ureal_2_10_18 return Ureal;
 134    --  Returns value 2.0 * 10.0 ** 18
 135
 136    function Ureal_M_2_10_18 return Ureal;
 137    --  Returns value -2.0 * 10.0 ** 18
 138
 139    function Ureal_9_10_36 return Ureal;
 140    --  Returns value 9.0 * 10.0 ** 36
 141
 142    function Ureal_M_9_10_36 return Ureal;
 143    --  Returns value -9.0 * 10.0 ** 36
 144
 145    function Ureal_10_76 return Ureal;
 146    --  Returns value 10.0 ** 76
 147
 148    function Ureal_M_10_76 return Ureal;
 149    --  Returns value -10.0 ** 76
 150
 151    -----------------
 152    -- Subprograms --
 153    -----------------
 154
 155    procedure Initialize;
 156    --  Initialize Ureal tables. Note that there is no Lock routine in this
 157    --  unit. These tables are among the few tables that can be expanded
 158    --  during Gigi processing.
 159
 160    function Rbase (Real : Ureal) return Nat;
 161    --  Return the base of the universal real
 162
 163    function Denominator (Real : Ureal) return Uint;
 164    --  Return the denominator of the universal real
 165
 166    function Numerator (Real : Ureal) return Uint;
 167    --  Return the numerator of the universal real
 168
 169    function Norm_Den (Real : Ureal) return Uint;
 170    --  Return the denominator of the universal real after a normalization
 171
 172    function Norm_Num (Real : Ureal) return Uint;
 173    --  Return the numerator of the universal real after a normalization
 174
 175    function UR_From_Uint (UI : Uint) return Ureal;
 176    --  Returns real corresponding to universal integer value
 177
 178    function UR_To_Uint (Real : Ureal) return Uint;
 179    --  Return integer value obtained by accurate rounding of real value.
 180    --  The rounding of values half way between two integers is away from
 181    --  zero, as required by normal Ada 95 rounding semantics.
 182
 183    function UR_Trunc (Real : Ureal) return Uint;
 184    --  Return integer value obtained by a truncation of real towards zero
 185
 186    function UR_Ceiling (Real : Ureal) return Uint;
 187    --  Return value of smallest integer not less than the given value
 188
 189    function UR_Floor (Real : Ureal) return Uint;
 190    --  Return value of smallest integer not greater than the given value
 191
 192    --  Conversion table for above four functions
 193
 194    --    Input    To_Uint    Trunc    Ceiling    Floor
 195    --     1.0        1         1         1         1
 196    --     1.2        1         1         2         1
 197    --     1.5        2         1         2         1
 198    --     1.7        2         1         2         1
 199    --     2.0        2         2         2         2
 200    --    -1.0       -1        -1        -1        -1
 201    --    -1.2       -1        -1        -1        -2
 202    --    -1.5       -2        -1        -1        -2
 203    --    -1.7       -2        -1        -1        -2
 204    --    -2.0       -2        -2        -2        -2
 205
 206    function UR_From_Components
 207      (Num      : Uint;
 208       Den      : Uint;
 209       Rbase    : Nat := 0;
 210       Negative : Boolean := False)
 211       return     Ureal;
 212    --  Builds real value from given numerator, denominator and base. The
 213    --  value is negative if Negative is set to true, and otherwise is
 214    --  non-negative.
 215
 216    function UR_Add (Left : Ureal; Right : Ureal) return Ureal;
 217    function UR_Add (Left : Ureal; Right : Uint)  return Ureal;
 218    function UR_Add (Left : Uint;  Right : Ureal) return Ureal;
 219    --  Returns real sum of operands
 220
 221    function UR_Div (Left : Ureal; Right : Ureal) return Ureal;
 222    function UR_Div (Left : Uint;  Right : Ureal) return Ureal;
 223    function UR_Div (Left : Ureal; Right : Uint)  return Ureal;
 224    --  Returns real quotient of operands. Fatal error if Right is zero
 225
 226    function UR_Mul (Left : Ureal; Right : Ureal) return Ureal;
 227    function UR_Mul (Left : Uint;  Right : Ureal) return Ureal;
 228    function UR_Mul (Left : Ureal; Right : Uint)  return Ureal;
 229    --  Returns real product of operands
 230
 231    function UR_Sub (Left : Ureal; Right : Ureal) return Ureal;
 232    function UR_Sub (Left : Uint;  Right : Ureal) return Ureal;
 233    function UR_Sub (Left : Ureal; Right : Uint)  return Ureal;
 234    --  Returns real difference of operands
 235
 236    function UR_Exponentiate (Real  : Ureal; N : Uint) return  Ureal;
 237    --  Returns result of raising Ureal to Uint power.
 238    --  Fatal error if Left is 0 and Right is negative.
 239
 240    function UR_Abs (Real : Ureal) return Ureal;
 241    --  Returns abs function of real
 242
 243    function UR_Negate (Real : Ureal) return Ureal;
 244    --  Returns negative of real
 245
 246    function UR_Eq (Left, Right : Ureal) return Boolean;
 247    --  Compares reals for equality
 248
 249    function UR_Max (Left, Right : Ureal) return Ureal;
 250    --  Returns the maximum of two reals
 251
 252    function UR_Min (Left, Right : Ureal) return Ureal;
 253    --  Returns the minimum of two reals
 254
 255    function UR_Ne (Left, Right : Ureal) return Boolean;
 256    --  Compares reals for inequality
 257
 258    function UR_Lt (Left, Right : Ureal) return Boolean;
 259    --  Compares reals for less than
 260
 261    function UR_Le (Left, Right : Ureal) return Boolean;
 262    --  Compares reals for less than or equal
 263
 264    function UR_Gt (Left, Right : Ureal) return Boolean;
 265    --  Compares reals for greater than
 266
 267    function UR_Ge (Left, Right : Ureal) return Boolean;
 268    --  Compares reals for greater than or equal
 269
 270    function UR_Is_Zero (Real : Ureal) return Boolean;
 271    --  Tests if real value is zero
 272
 273    function UR_Is_Negative (Real : Ureal) return Boolean;
 274    --  Tests if real value is negative, note that negative zero gives true
 275
 276    function UR_Is_Positive (Real : Ureal) return Boolean;
 277    --  Test if real value is greater than zero
 278
 279    procedure UR_Write (Real : Ureal; Brackets : Boolean := False);
 280    --  Writes value of Real to standard output. Used for debugging and
 281    --  tree/source output, and also for -gnatR representation output. If the
 282    --  result is easily representable as a standard Ada literal, it will be
 283    --  given that way, but as a result of evaluation of static expressions, it
 284    --  is possible to generate constants (e.g. 1/13) which have no such
 285    --  representation. In such cases (and in cases where it is too much work to
 286    --  figure out the Ada literal), the string that is output is of the form
 287    --  of some expression such as integer/integer, or integer*integer**integer.
 288    --  In the case where an expression is output, if Brackets is set to True,
 289    --  the expression is surrounded by square brackets.
 290
 291    procedure UR_Write_To_JSON (Real : Ureal);
 292    --  Writes value of Real to standard output in the JSON data interchange
 293    --  format specified by the ECMA-404 standard, for the -gnatRj output.
 294
 295    procedure pr (Real : Ureal);
 296    pragma Export (Ada, pr);
 297    --  Writes value of Real to standard output with a terminating line return,
 298    --  using UR_Write as described above. This is for use from the debugger.
 299
 300    ------------------------
 301    -- Operator Renamings --
 302    ------------------------
 303
 304    function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
 305    function "+" (Left : Uint;  Right : Ureal) return Ureal renames UR_Add;
 306    function "+" (Left : Ureal; Right : Uint)  return Ureal renames UR_Add;
 307
 308    function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
 309    function "/" (Left : Uint;  Right : Ureal) return Ureal renames UR_Div;
 310    function "/" (Left : Ureal; Right : Uint)  return Ureal renames UR_Div;
 311
 312    function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
 313    function "*" (Left : Uint;  Right : Ureal) return Ureal renames UR_Mul;
 314    function "*" (Left : Ureal; Right : Uint)  return Ureal renames UR_Mul;
 315
 316    function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
 317    function "-" (Left : Uint;  Right : Ureal) return Ureal renames UR_Sub;
 318    function "-" (Left : Ureal; Right : Uint)  return Ureal renames UR_Sub;
 319
 320    function "**"  (Real  : Ureal; N : Uint) return Ureal
 321                                                      renames UR_Exponentiate;
 322
 323    function "abs" (Real : Ureal) return Ureal renames UR_Abs;
 324
 325    function "-"   (Real : Ureal) return Ureal renames UR_Negate;
 326
 327    function "="   (Left, Right : Ureal) return Boolean renames UR_Eq;
 328
 329    function "<"   (Left, Right : Ureal) return Boolean renames UR_Lt;
 330
 331    function "<="  (Left, Right : Ureal) return Boolean renames UR_Le;
 332
 333    function ">="  (Left, Right : Ureal) return Boolean renames UR_Ge;
 334
 335    function ">"   (Left, Right : Ureal) return Boolean renames UR_Gt;
 336
 337    -----------------------------
 338    -- Mark/Release Processing --
 339    -----------------------------
 340
 341    --  The space used by Ureal data is not automatically reclaimed. However,
 342    --  a mark-release regime is implemented which allows storage to be
 343    --  released back to a previously noted mark. This is used for example
 344    --  when doing comparisons, where only intermediate results get stored
 345    --  that do not need to be saved for future use.
 346
 347    type Save_Mark is private;
 348
 349    function Mark return Save_Mark;
 350    --  Note mark point for future release
 351
 352    procedure Release (M : Save_Mark);
 353    --  Release storage allocated since mark was noted
 354
 355    ------------------------------------
 356    -- Representation of Ureal Values --
 357    ------------------------------------
 358
 359 private
 360
 361    type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
 362    for Ureal'Size use 32;
 363
 364    No_Ureal : constant Ureal := Ureal'First;
 365
 366    type Save_Mark is new Int;
 367
 368    pragma Inline (Denominator);
 369    pragma Inline (Mark);
 370    pragma Inline (Norm_Num);
 371    pragma Inline (Norm_Den);
 372    pragma Inline (Numerator);
 373    pragma Inline (Rbase);
 374    pragma Inline (Release);
 375    pragma Inline (Ureal_0);
 376    pragma Inline (Ureal_M_0);
 377    pragma Inline (Ureal_Tenth);
 378    pragma Inline (Ureal_Half);
 379    pragma Inline (Ureal_1);
 380    pragma Inline (Ureal_2);
 381    pragma Inline (Ureal_10);
 382    pragma Inline (UR_From_Components);
 383
 384 end Urealp;