blob: 5c625f9b949ff01b4cea9fdabdf56dd5fcd5df65 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- U R E A L P --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Support for universal real arithmetic
-- WARNING: There is a C version of this package. Any changes to this
-- source file must be properly reflected in the C header file urealp.h
with Types; use Types;
with Uintp; use Uintp;
package Urealp is
---------------------------------------
-- Representation of Universal Reals --
---------------------------------------
-- A universal real value is represented by a single value (which is
-- an index into an internal table). These values are not hashed, so
-- the equality operator should not be used on Ureal values (instead
-- use the UR_Eq function).
-- A Ureal value represents an arbitrary precision universal real value,
-- stored internally using four components:
-- the numerator (Uint, always non-negative)
-- the denominator (Uint, always non-zero, always positive if base = 0)
-- a real base (Nat, either zero, or in the range 2 .. 16)
-- a sign flag (Boolean), set if negative
-- Negative numbers are represented by the sign flag being True.
-- If the base is zero, then the absolute value of the Ureal is simply
-- numerator/denominator, where denominator is positive. If the base is
-- non-zero, then the absolute value is numerator / (base ** denominator).
-- In that case, since base is positive, (base ** denominator) is also
-- positive, even when denominator is negative or null.
-- A normalized Ureal value has base = 0, and numerator/denominator
-- reduced to lowest terms, with zero itself being represented as 0/1.
-- This is a canonical format, so that for normalized Ureal values it
-- is the case that two equal values always have the same denominator
-- and numerator values.
-- Note: a value of minus zero is legitimate, and the operations in
-- Urealp preserve the handling of signed zeroes in accordance with
-- the rules of IEEE P754 ("IEEE floating point").
------------------------------
-- Types for Urealp Package --
------------------------------
type Ureal is private;
-- Type used for representation of universal reals
No_Ureal : constant Ureal;
-- Constant used to indicate missing or unset Ureal value
---------------------
-- Ureal Constants --
---------------------
function Ureal_0 return Ureal;
-- Returns value 0.0
function Ureal_M_0 return Ureal;
-- Returns value -0.0
function Ureal_Tenth return Ureal;
-- Returns value 0.1
function Ureal_Half return Ureal;
-- Returns value 0.5
function Ureal_1 return Ureal;
-- Returns value 1.0
function Ureal_2 return Ureal;
-- Returns value 2.0
function Ureal_10 return Ureal;
-- Returns value 10.0
function Ureal_100 return Ureal;
-- Returns value 100.0
function Ureal_2_31 return Ureal;
-- Returns value 2.0 ** 31
function Ureal_2_63 return Ureal;
-- Returns value 2.0 ** 63
function Ureal_2_80 return Ureal;
-- Returns value 2.0 ** 80
function Ureal_2_M_80 return Ureal;
-- Returns value 2.0 ** (-80)
function Ureal_2_127 return Ureal;
-- Returns value 2.0 ** 127
function Ureal_2_M_127 return Ureal;
-- Returns value 2.0 ** (-127)
function Ureal_2_128 return Ureal;
-- Returns value 2.0 ** 128
function Ureal_2_M_128 return Ureal;
-- Returns value 2.0 ** (-128)
function Ureal_2_10_18 return Ureal;
-- Returns value 2.0 * 10.0 ** 18
function Ureal_M_2_10_18 return Ureal;
-- Returns value -2.0 * 10.0 ** 18
function Ureal_9_10_36 return Ureal;
-- Returns value 9.0 * 10.0 ** 36
function Ureal_M_9_10_36 return Ureal;
-- Returns value -9.0 * 10.0 ** 36
function Ureal_10_76 return Ureal;
-- Returns value 10.0 ** 76
function Ureal_M_10_76 return Ureal;
-- Returns value -10.0 ** 76
-----------------
-- Subprograms --
-----------------
procedure Initialize;
-- Initialize Ureal tables. Note that there is no Lock routine in this
-- unit. These tables are among the few tables that can be expanded
-- during Gigi processing.
function Rbase (Real : Ureal) return Nat;
-- Return the base of the universal real
function Denominator (Real : Ureal) return Uint;
-- Return the denominator of the universal real
function Numerator (Real : Ureal) return Uint;
-- Return the numerator of the universal real
function Norm_Den (Real : Ureal) return Uint;
-- Return the denominator of the universal real after a normalization
function Norm_Num (Real : Ureal) return Uint;
-- Return the numerator of the universal real after a normalization
function UR_From_Uint (UI : Uint) return Ureal;
-- Returns real corresponding to universal integer value
function UR_To_Uint (Real : Ureal) return Uint;
-- Return integer value obtained by accurate rounding of real value.
-- The rounding of values half way between two integers is away from
-- zero, as required by normal Ada 95 rounding semantics.
function UR_Trunc (Real : Ureal) return Uint;
-- Return integer value obtained by a truncation of real towards zero
function UR_Ceiling (Real : Ureal) return Uint;
-- Return value of smallest integer not less than the given value
function UR_Floor (Real : Ureal) return Uint;
-- Return value of smallest integer not greater than the given value
-- Conversion table for above four functions
-- Input To_Uint Trunc Ceiling Floor
-- 1.0 1 1 1 1
-- 1.2 1 1 2 1
-- 1.5 2 1 2 1
-- 1.7 2 1 2 1
-- 2.0 2 2 2 2
-- -1.0 -1 -1 -1 -1
-- -1.2 -1 -1 -1 -2
-- -1.5 -2 -1 -1 -2
-- -1.7 -2 -1 -1 -2
-- -2.0 -2 -2 -2 -2
function UR_From_Components
(Num : Uint;
Den : Uint;
Rbase : Nat := 0;
Negative : Boolean := False)
return Ureal;
-- Builds real value from given numerator, denominator and base. The
-- value is negative if Negative is set to true, and otherwise is
-- non-negative.
function UR_Add (Left : Ureal; Right : Ureal) return Ureal;
function UR_Add (Left : Ureal; Right : Uint) return Ureal;
function UR_Add (Left : Uint; Right : Ureal) return Ureal;
-- Returns real sum of operands
function UR_Div (Left : Ureal; Right : Ureal) return Ureal;
function UR_Div (Left : Uint; Right : Ureal) return Ureal;
function UR_Div (Left : Ureal; Right : Uint) return Ureal;
-- Returns real quotient of operands. Fatal error if Right is zero
function UR_Mul (Left : Ureal; Right : Ureal) return Ureal;
function UR_Mul (Left : Uint; Right : Ureal) return Ureal;
function UR_Mul (Left : Ureal; Right : Uint) return Ureal;
-- Returns real product of operands
function UR_Sub (Left : Ureal; Right : Ureal) return Ureal;
function UR_Sub (Left : Uint; Right : Ureal) return Ureal;
function UR_Sub (Left : Ureal; Right : Uint) return Ureal;
-- Returns real difference of operands
function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal;
-- Returns result of raising Ureal to Uint power.
-- Fatal error if Left is 0 and Right is negative.
function UR_Abs (Real : Ureal) return Ureal;
-- Returns abs function of real
function UR_Negate (Real : Ureal) return Ureal;
-- Returns negative of real
function UR_Eq (Left, Right : Ureal) return Boolean;
-- Compares reals for equality
function UR_Max (Left, Right : Ureal) return Ureal;
-- Returns the maximum of two reals
function UR_Min (Left, Right : Ureal) return Ureal;
-- Returns the minimum of two reals
function UR_Ne (Left, Right : Ureal) return Boolean;
-- Compares reals for inequality
function UR_Lt (Left, Right : Ureal) return Boolean;
-- Compares reals for less than
function UR_Le (Left, Right : Ureal) return Boolean;
-- Compares reals for less than or equal
function UR_Gt (Left, Right : Ureal) return Boolean;
-- Compares reals for greater than
function UR_Ge (Left, Right : Ureal) return Boolean;
-- Compares reals for greater than or equal
function UR_Is_Zero (Real : Ureal) return Boolean;
-- Tests if real value is zero
function UR_Is_Negative (Real : Ureal) return Boolean;
-- Tests if real value is negative, note that negative zero gives true
function UR_Is_Positive (Real : Ureal) return Boolean;
-- Test if real value is greater than zero
procedure UR_Write (Real : Ureal; Brackets : Boolean := False);
-- Writes value of Real to standard output. Used for debugging and
-- tree/source output, and also for -gnatR representation output. If the
-- result is easily representable as a standard Ada literal, it will be
-- given that way, but as a result of evaluation of static expressions, it
-- is possible to generate constants (e.g. 1/13) which have no such
-- representation. In such cases (and in cases where it is too much work to
-- figure out the Ada literal), the string that is output is of the form
-- of some expression such as integer/integer, or integer*integer**integer.
-- In the case where an expression is output, if Brackets is set to True,
-- the expression is surrounded by square brackets.
procedure UR_Write_To_JSON (Real : Ureal);
-- Writes value of Real to standard output in the JSON data interchange
-- format specified by the ECMA-404 standard, for the -gnatRj output.
procedure pr (Real : Ureal);
pragma Export (Ada, pr);
-- Writes value of Real to standard output with a terminating line return,
-- using UR_Write as described above. This is for use from the debugger.
------------------------
-- Operator Renamings --
------------------------
function "+" (Left : Ureal; Right : Ureal) return Ureal renames UR_Add;
function "+" (Left : Uint; Right : Ureal) return Ureal renames UR_Add;
function "+" (Left : Ureal; Right : Uint) return Ureal renames UR_Add;
function "/" (Left : Ureal; Right : Ureal) return Ureal renames UR_Div;
function "/" (Left : Uint; Right : Ureal) return Ureal renames UR_Div;
function "/" (Left : Ureal; Right : Uint) return Ureal renames UR_Div;
function "*" (Left : Ureal; Right : Ureal) return Ureal renames UR_Mul;
function "*" (Left : Uint; Right : Ureal) return Ureal renames UR_Mul;
function "*" (Left : Ureal; Right : Uint) return Ureal renames UR_Mul;
function "-" (Left : Ureal; Right : Ureal) return Ureal renames UR_Sub;
function "-" (Left : Uint; Right : Ureal) return Ureal renames UR_Sub;
function "-" (Left : Ureal; Right : Uint) return Ureal renames UR_Sub;
function "**" (Real : Ureal; N : Uint) return Ureal
renames UR_Exponentiate;
function "abs" (Real : Ureal) return Ureal renames UR_Abs;
function "-" (Real : Ureal) return Ureal renames UR_Negate;
function "=" (Left, Right : Ureal) return Boolean renames UR_Eq;
function "<" (Left, Right : Ureal) return Boolean renames UR_Lt;
function "<=" (Left, Right : Ureal) return Boolean renames UR_Le;
function ">=" (Left, Right : Ureal) return Boolean renames UR_Ge;
function ">" (Left, Right : Ureal) return Boolean renames UR_Gt;
-----------------------------
-- Mark/Release Processing --
-----------------------------
-- The space used by Ureal data is not automatically reclaimed. However,
-- a mark-release regime is implemented which allows storage to be
-- released back to a previously noted mark. This is used for example
-- when doing comparisons, where only intermediate results get stored
-- that do not need to be saved for future use.
type Save_Mark is private;
function Mark return Save_Mark;
-- Note mark point for future release
procedure Release (M : Save_Mark);
-- Release storage allocated since mark was noted
------------------------------------
-- Representation of Ureal Values --
------------------------------------
private
type Ureal is new Int range Ureal_Low_Bound .. Ureal_High_Bound;
for Ureal'Size use 32;
No_Ureal : constant Ureal := Ureal'First;
type Save_Mark is new Int;
pragma Inline (Denominator);
pragma Inline (Mark);
pragma Inline (Norm_Num);
pragma Inline (Norm_Den);
pragma Inline (Numerator);
pragma Inline (Rbase);
pragma Inline (Release);
pragma Inline (Ureal_0);
pragma Inline (Ureal_M_0);
pragma Inline (Ureal_Tenth);
pragma Inline (Ureal_Half);
pragma Inline (Ureal_1);
pragma Inline (Ureal_2);
pragma Inline (Ureal_10);
pragma Inline (UR_From_Components);
end Urealp;