1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- Support for universal real arithmetic
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
31 with Types; use Types;
32 with Uintp; use Uintp;
36 ---------------------------------------
37 -- Representation of Universal Reals --
38 ---------------------------------------
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).
45 -- A Ureal value represents an arbitrary precision universal real value,
46 -- stored internally using four components:
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
53 -- Negative numbers are represented by the sign flag being True.
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.
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.
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").
71 ------------------------------
72 -- Types for Urealp Package --
73 ------------------------------
75 type Ureal is private;
76 -- Type used for representation of universal reals
78 No_Ureal : constant Ureal;
79 -- Constant used to indicate missing or unset Ureal value
85 function Ureal_0 return Ureal;
88 function Ureal_M_0 return Ureal;
91 function Ureal_Tenth return Ureal;
94 function Ureal_Half return Ureal;
97 function Ureal_1 return Ureal;
100 function Ureal_2 return Ureal;
103 function Ureal_10 return Ureal;
104 -- Returns value 10.0
106 function Ureal_100 return Ureal;
107 -- Returns value 100.0
109 function Ureal_2_31 return Ureal;
110 -- Returns value 2.0 ** 31
112 function Ureal_2_63 return Ureal;
113 -- Returns value 2.0 ** 63
115 function Ureal_2_80 return Ureal;
116 -- Returns value 2.0 ** 80
118 function Ureal_2_M_80 return Ureal;
119 -- Returns value 2.0 ** (-80)
121 function Ureal_2_127 return Ureal;
122 -- Returns value 2.0 ** 127
124 function Ureal_2_M_127 return Ureal;
125 -- Returns value 2.0 ** (-127)
127 function Ureal_2_128 return Ureal;
128 -- Returns value 2.0 ** 128
130 function Ureal_2_M_128 return Ureal;
131 -- Returns value 2.0 ** (-128)
133 function Ureal_2_10_18 return Ureal;
134 -- Returns value 2.0 * 10.0 ** 18
136 function Ureal_M_2_10_18 return Ureal;
137 -- Returns value -2.0 * 10.0 ** 18
139 function Ureal_9_10_36 return Ureal;
140 -- Returns value 9.0 * 10.0 ** 36
142 function Ureal_M_9_10_36 return Ureal;
143 -- Returns value -9.0 * 10.0 ** 36
145 function Ureal_10_76 return Ureal;
146 -- Returns value 10.0 ** 76
148 function Ureal_M_10_76 return Ureal;
149 -- Returns value -10.0 ** 76
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.
160 function Rbase (Real : Ureal) return Nat;
161 -- Return the base of the universal real
163 function Denominator (Real : Ureal) return Uint;
164 -- Return the denominator of the universal real
166 function Numerator (Real : Ureal) return Uint;
167 -- Return the numerator of the universal real
169 function Norm_Den (Real : Ureal) return Uint;
170 -- Return the denominator of the universal real after a normalization
172 function Norm_Num (Real : Ureal) return Uint;
173 -- Return the numerator of the universal real after a normalization
175 function UR_From_Uint (UI : Uint) return Ureal;
176 -- Returns real corresponding to universal integer value
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.
183 function UR_Trunc (Real : Ureal) return Uint;
184 -- Return integer value obtained by a truncation of real towards zero
186 function UR_Ceiling (Real : Ureal) return Uint;
187 -- Return value of smallest integer not less than the given value
189 function UR_Floor (Real : Ureal) return Uint;
190 -- Return value of smallest integer not greater than the given value
192 -- Conversion table for above four functions
194 -- Input To_Uint Trunc Ceiling Floor
206 function UR_From_Components
210 Negative : Boolean := False)
212 -- Builds real value from given numerator, denominator and base. The
213 -- value is negative if Negative is set to true, and otherwise is
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
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
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
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
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.
240 function UR_Abs (Real : Ureal) return Ureal;
241 -- Returns abs function of real
243 function UR_Negate (Real : Ureal) return Ureal;
244 -- Returns negative of real
246 function UR_Eq (Left, Right : Ureal) return Boolean;
247 -- Compares reals for equality
249 function UR_Max (Left, Right : Ureal) return Ureal;
250 -- Returns the maximum of two reals
252 function UR_Min (Left, Right : Ureal) return Ureal;
253 -- Returns the minimum of two reals
255 function UR_Ne (Left, Right : Ureal) return Boolean;
256 -- Compares reals for inequality
258 function UR_Lt (Left, Right : Ureal) return Boolean;
259 -- Compares reals for less than
261 function UR_Le (Left, Right : Ureal) return Boolean;
262 -- Compares reals for less than or equal
264 function UR_Gt (Left, Right : Ureal) return Boolean;
265 -- Compares reals for greater than
267 function UR_Ge (Left, Right : Ureal) return Boolean;
268 -- Compares reals for greater than or equal
270 function UR_Is_Zero (Real : Ureal) return Boolean;
271 -- Tests if real value is zero
273 function UR_Is_Negative (Real : Ureal) return Boolean;
274 -- Tests if real value is negative, note that negative zero gives true
276 function UR_Is_Positive (Real : Ureal) return Boolean;
277 -- Test if real value is greater than zero
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.
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.
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.
300 ------------------------
301 -- Operator Renamings --
302 ------------------------
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;
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;
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;
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;
320 function "**" (Real : Ureal; N : Uint) return Ureal
321 renames UR_Exponentiate;
323 function "abs" (Real : Ureal) return Ureal renames UR_Abs;
325 function "-" (Real : Ureal) return Ureal renames UR_Negate;
327 function "=" (Left, Right : Ureal) return Boolean renames UR_Eq;
329 function "<" (Left, Right : Ureal) return Boolean renames UR_Lt;
331 function "<=" (Left, Right : Ureal) return Boolean renames UR_Le;
333 function ">=" (Left, Right : Ureal) return Boolean renames UR_Ge;
335 function ">" (Left, Right : Ureal) return Boolean renames UR_Gt;
337 -----------------------------
338 -- Mark/Release Processing --
339 -----------------------------
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.
347 type Save_Mark is private;
349 function Mark return Save_Mark;
350 -- Note mark point for future release
352 procedure Release (M : Save_Mark);
353 -- Release storage allocated since mark was noted
355 ------------------------------------
356 -- Representation of Ureal Values --
357 ------------------------------------
361 type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
362 for Ureal'Size use 32;
364 No_Ureal : constant Ureal := Ureal'First;
366 type Save_Mark is new Int;
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);