| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- U R E A L P -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2014, 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. -- |
| -- -- |
| -- As a special exception under Section 7 of GPL version 3, you are granted -- |
| -- additional permissions described in the GCC Runtime Library Exception, -- |
| -- version 3.1, as published by the Free Software Foundation. -- |
| -- -- |
| -- You should have received a copy of the GNU General Public License and -- |
| -- a copy of the GCC Runtime Library Exception along with this program; -- |
| -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- |
| -- <http://www.gnu.org/licenses/>. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Alloc; |
| with Output; use Output; |
| with Table; |
| with Tree_IO; use Tree_IO; |
| |
| package body Urealp is |
| |
| Ureal_First_Entry : constant Ureal := Ureal'Succ (No_Ureal); |
| -- First subscript allocated in Ureal table (note that we can't just |
| -- add 1 to No_Ureal, since "+" means something different for Ureals). |
| |
| type Ureal_Entry is record |
| Num : Uint; |
| -- Numerator (always non-negative) |
| |
| Den : Uint; |
| -- Denominator (always non-zero, always positive if base is zero) |
| |
| Rbase : Nat; |
| -- Base value. If Rbase is zero, then the value is simply Num / Den. |
| -- If Rbase is non-zero, then the value is Num / (Rbase ** Den) |
| |
| Negative : Boolean; |
| -- Flag set if value is negative |
| end record; |
| |
| -- The following representation clause ensures that the above record |
| -- has no holes. We do this so that when instances of this record are |
| -- written by Tree_Gen, we do not write uninitialized values to the file. |
| |
| for Ureal_Entry use record |
| Num at 0 range 0 .. 31; |
| Den at 4 range 0 .. 31; |
| Rbase at 8 range 0 .. 31; |
| Negative at 12 range 0 .. 31; |
| end record; |
| |
| for Ureal_Entry'Size use 16 * 8; |
| -- This ensures that we did not leave out any fields |
| |
| package Ureals is new Table.Table ( |
| Table_Component_Type => Ureal_Entry, |
| Table_Index_Type => Ureal'Base, |
| Table_Low_Bound => Ureal_First_Entry, |
| Table_Initial => Alloc.Ureals_Initial, |
| Table_Increment => Alloc.Ureals_Increment, |
| Table_Name => "Ureals"); |
| |
| -- The following universal reals are the values returned by the constant |
| -- functions. They are initialized by the initialization procedure. |
| |
| UR_0 : Ureal; |
| UR_M_0 : Ureal; |
| UR_Tenth : Ureal; |
| UR_Half : Ureal; |
| UR_1 : Ureal; |
| UR_2 : Ureal; |
| UR_10 : Ureal; |
| UR_10_36 : Ureal; |
| UR_M_10_36 : Ureal; |
| UR_100 : Ureal; |
| UR_2_128 : Ureal; |
| UR_2_80 : Ureal; |
| UR_2_M_128 : Ureal; |
| UR_2_M_80 : Ureal; |
| |
| Num_Ureal_Constants : constant := 10; |
| -- This is used for an assertion check in Tree_Read and Tree_Write to |
| -- help remember to add values to these routines when we add to the list. |
| |
| Normalized_Real : Ureal := No_Ureal; |
| -- Used to memoize Norm_Num and Norm_Den, if either of these functions |
| -- is called, this value is set and Normalized_Entry contains the result |
| -- of the normalization. On subsequent calls, this is used to avoid the |
| -- call to Normalize if it has already been made. |
| |
| Normalized_Entry : Ureal_Entry; |
| -- Entry built by most recent call to Normalize |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| function Decimal_Exponent_Hi (V : Ureal) return Int; |
| -- Returns an estimate of the exponent of Val represented as a normalized |
| -- decimal number (non-zero digit before decimal point), The estimate is |
| -- either correct, or high, but never low. The accuracy of the estimate |
| -- affects only the efficiency of the comparison routines. |
| |
| function Decimal_Exponent_Lo (V : Ureal) return Int; |
| -- Returns an estimate of the exponent of Val represented as a normalized |
| -- decimal number (non-zero digit before decimal point), The estimate is |
| -- either correct, or low, but never high. The accuracy of the estimate |
| -- affects only the efficiency of the comparison routines. |
| |
| function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int; |
| -- U is a Ureal entry for which the base value is non-zero, the value |
| -- returned is the equivalent decimal exponent value, i.e. the value of |
| -- Den, adjusted as though the base were base 10. The value is rounded |
| -- toward zero (truncated), and so its value can be off by one. |
| |
| function Is_Integer (Num, Den : Uint) return Boolean; |
| -- Return true if the real quotient of Num / Den is an integer value |
| |
| function Normalize (Val : Ureal_Entry) return Ureal_Entry; |
| -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a base |
| -- value of 0). |
| |
| function Same (U1, U2 : Ureal) return Boolean; |
| pragma Inline (Same); |
| -- Determines if U1 and U2 are the same Ureal. Note that we cannot use |
| -- the equals operator for this test, since that tests for equality, not |
| -- identity. |
| |
| function Store_Ureal (Val : Ureal_Entry) return Ureal; |
| -- This store a new entry in the universal reals table and return its index |
| -- in the table. |
| |
| function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal; |
| pragma Inline (Store_Ureal_Normalized); |
| -- Like Store_Ureal, but normalizes its operand first |
| |
| ------------------------- |
| -- Decimal_Exponent_Hi -- |
| ------------------------- |
| |
| function Decimal_Exponent_Hi (V : Ureal) return Int is |
| Val : constant Ureal_Entry := Ureals.Table (V); |
| |
| begin |
| -- Zero always returns zero |
| |
| if UR_Is_Zero (V) then |
| return 0; |
| |
| -- For numbers in rational form, get the maximum number of digits in the |
| -- numerator and the minimum number of digits in the denominator, and |
| -- subtract. For example: |
| |
| -- 1000 / 99 = 1.010E+1 |
| -- 9999 / 10 = 9.999E+2 |
| |
| -- This estimate may of course be high, but that is acceptable |
| |
| elsif Val.Rbase = 0 then |
| return UI_Decimal_Digits_Hi (Val.Num) - |
| UI_Decimal_Digits_Lo (Val.Den); |
| |
| -- For based numbers, just subtract the decimal exponent from the |
| -- high estimate of the number of digits in the numerator and add |
| -- one to accommodate possible round off errors for non-decimal |
| -- bases. For example: |
| |
| -- 1_500_000 / 10**4 = 1.50E-2 |
| |
| else -- Val.Rbase /= 0 |
| return UI_Decimal_Digits_Hi (Val.Num) - |
| Equivalent_Decimal_Exponent (Val) + 1; |
| end if; |
| end Decimal_Exponent_Hi; |
| |
| ------------------------- |
| -- Decimal_Exponent_Lo -- |
| ------------------------- |
| |
| function Decimal_Exponent_Lo (V : Ureal) return Int is |
| Val : constant Ureal_Entry := Ureals.Table (V); |
| |
| begin |
| -- Zero always returns zero |
| |
| if UR_Is_Zero (V) then |
| return 0; |
| |
| -- For numbers in rational form, get min digits in numerator, max digits |
| -- in denominator, and subtract and subtract one more for possible loss |
| -- during the division. For example: |
| |
| -- 1000 / 99 = 1.010E+1 |
| -- 9999 / 10 = 9.999E+2 |
| |
| -- This estimate may of course be low, but that is acceptable |
| |
| elsif Val.Rbase = 0 then |
| return UI_Decimal_Digits_Lo (Val.Num) - |
| UI_Decimal_Digits_Hi (Val.Den) - 1; |
| |
| -- For based numbers, just subtract the decimal exponent from the |
| -- low estimate of the number of digits in the numerator and subtract |
| -- one to accommodate possible round off errors for non-decimal |
| -- bases. For example: |
| |
| -- 1_500_000 / 10**4 = 1.50E-2 |
| |
| else -- Val.Rbase /= 0 |
| return UI_Decimal_Digits_Lo (Val.Num) - |
| Equivalent_Decimal_Exponent (Val) - 1; |
| end if; |
| end Decimal_Exponent_Lo; |
| |
| ----------------- |
| -- Denominator -- |
| ----------------- |
| |
| function Denominator (Real : Ureal) return Uint is |
| begin |
| return Ureals.Table (Real).Den; |
| end Denominator; |
| |
| --------------------------------- |
| -- Equivalent_Decimal_Exponent -- |
| --------------------------------- |
| |
| function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is |
| |
| type Ratio is record |
| Num : Nat; |
| Den : Nat; |
| end record; |
| |
| -- The following table is a table of logs to the base 10. All values |
| -- have at least 15 digits of precision, and do not exceed the true |
| -- value. To avoid the use of floating point, and as a result potential |
| -- target dependency, each entry is represented as a fraction of two |
| -- integers. |
| |
| Logs : constant array (Nat range 1 .. 16) of Ratio := |
| (1 => (Num => 0, Den => 1), -- 0 |
| 2 => (Num => 15_392_313, Den => 51_132_157), -- 0.301029995663981 |
| 3 => (Num => 731_111_920, Den => 1532_339_867), -- 0.477121254719662 |
| 4 => (Num => 30_784_626, Den => 51_132_157), -- 0.602059991327962 |
| 5 => (Num => 111_488_153, Den => 159_503_487), -- 0.698970004336018 |
| 6 => (Num => 84_253_929, Den => 108_274_489), -- 0.778151250383643 |
| 7 => (Num => 35_275_468, Den => 41_741_273), -- 0.845098040014256 |
| 8 => (Num => 46_176_939, Den => 51_132_157), -- 0.903089986991943 |
| 9 => (Num => 417_620_173, Den => 437_645_744), -- 0.954242509439324 |
| 10 => (Num => 1, Den => 1), -- 1.000000000000000 |
| 11 => (Num => 136_507_510, Den => 131_081_687), -- 1.041392685158225 |
| 12 => (Num => 26_797_783, Den => 24_831_587), -- 1.079181246047624 |
| 13 => (Num => 73_333_297, Den => 65_832_160), -- 1.113943352306836 |
| 14 => (Num => 102_941_258, Den => 89_816_543), -- 1.146128035678238 |
| 15 => (Num => 53_385_559, Den => 45_392_361), -- 1.176091259055681 |
| 16 => (Num => 78_897_839, Den => 65_523_237)); -- 1.204119982655924 |
| |
| function Scale (X : Int; R : Ratio) return Int; |
| -- Compute the value of X scaled by R |
| |
| ----------- |
| -- Scale -- |
| ----------- |
| |
| function Scale (X : Int; R : Ratio) return Int is |
| type Wide_Int is range -2**63 .. 2**63 - 1; |
| |
| begin |
| return Int (Wide_Int (X) * Wide_Int (R.Num) / Wide_Int (R.Den)); |
| end Scale; |
| |
| begin |
| pragma Assert (U.Rbase /= 0); |
| return Scale (UI_To_Int (U.Den), Logs (U.Rbase)); |
| end Equivalent_Decimal_Exponent; |
| |
| ---------------- |
| -- Initialize -- |
| ---------------- |
| |
| procedure Initialize is |
| begin |
| Ureals.Init; |
| UR_0 := UR_From_Components (Uint_0, Uint_1, 0, False); |
| UR_M_0 := UR_From_Components (Uint_0, Uint_1, 0, True); |
| UR_Half := UR_From_Components (Uint_1, Uint_1, 2, False); |
| UR_Tenth := UR_From_Components (Uint_1, Uint_1, 10, False); |
| UR_1 := UR_From_Components (Uint_1, Uint_1, 0, False); |
| UR_2 := UR_From_Components (Uint_1, Uint_Minus_1, 2, False); |
| UR_10 := UR_From_Components (Uint_1, Uint_Minus_1, 10, False); |
| UR_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, False); |
| UR_M_10_36 := UR_From_Components (Uint_1, Uint_Minus_36, 10, True); |
| UR_100 := UR_From_Components (Uint_1, Uint_Minus_2, 10, False); |
| UR_2_128 := UR_From_Components (Uint_1, Uint_Minus_128, 2, False); |
| UR_2_M_128 := UR_From_Components (Uint_1, Uint_128, 2, False); |
| UR_2_80 := UR_From_Components (Uint_1, Uint_Minus_80, 2, False); |
| UR_2_M_80 := UR_From_Components (Uint_1, Uint_80, 2, False); |
| end Initialize; |
| |
| ---------------- |
| -- Is_Integer -- |
| ---------------- |
| |
| function Is_Integer (Num, Den : Uint) return Boolean is |
| begin |
| return (Num / Den) * Den = Num; |
| end Is_Integer; |
| |
| ---------- |
| -- Mark -- |
| ---------- |
| |
| function Mark return Save_Mark is |
| begin |
| return Save_Mark (Ureals.Last); |
| end Mark; |
| |
| -------------- |
| -- Norm_Den -- |
| -------------- |
| |
| function Norm_Den (Real : Ureal) return Uint is |
| begin |
| if not Same (Real, Normalized_Real) then |
| Normalized_Real := Real; |
| Normalized_Entry := Normalize (Ureals.Table (Real)); |
| end if; |
| |
| return Normalized_Entry.Den; |
| end Norm_Den; |
| |
| -------------- |
| -- Norm_Num -- |
| -------------- |
| |
| function Norm_Num (Real : Ureal) return Uint is |
| begin |
| if not Same (Real, Normalized_Real) then |
| Normalized_Real := Real; |
| Normalized_Entry := Normalize (Ureals.Table (Real)); |
| end if; |
| |
| return Normalized_Entry.Num; |
| end Norm_Num; |
| |
| --------------- |
| -- Normalize -- |
| --------------- |
| |
| function Normalize (Val : Ureal_Entry) return Ureal_Entry is |
| J : Uint; |
| K : Uint; |
| Tmp : Uint; |
| Num : Uint; |
| Den : Uint; |
| M : constant Uintp.Save_Mark := Uintp.Mark; |
| |
| begin |
| -- Start by setting J to the greatest of the absolute values of the |
| -- numerator and the denominator (taking into account the base value), |
| -- and K to the lesser of the two absolute values. The gcd of Num and |
| -- Den is the gcd of J and K. |
| |
| if Val.Rbase = 0 then |
| J := Val.Num; |
| K := Val.Den; |
| |
| elsif Val.Den < 0 then |
| J := Val.Num * Val.Rbase ** (-Val.Den); |
| K := Uint_1; |
| |
| else |
| J := Val.Num; |
| K := Val.Rbase ** Val.Den; |
| end if; |
| |
| Num := J; |
| Den := K; |
| |
| if K > J then |
| Tmp := J; |
| J := K; |
| K := Tmp; |
| end if; |
| |
| J := UI_GCD (J, K); |
| Num := Num / J; |
| Den := Den / J; |
| Uintp.Release_And_Save (M, Num, Den); |
| |
| -- Divide numerator and denominator by gcd and return result |
| |
| return (Num => Num, |
| Den => Den, |
| Rbase => 0, |
| Negative => Val.Negative); |
| end Normalize; |
| |
| --------------- |
| -- Numerator -- |
| --------------- |
| |
| function Numerator (Real : Ureal) return Uint is |
| begin |
| return Ureals.Table (Real).Num; |
| end Numerator; |
| |
| -------- |
| -- pr -- |
| -------- |
| |
| procedure pr (Real : Ureal) is |
| begin |
| UR_Write (Real); |
| Write_Eol; |
| end pr; |
| |
| ----------- |
| -- Rbase -- |
| ----------- |
| |
| function Rbase (Real : Ureal) return Nat is |
| begin |
| return Ureals.Table (Real).Rbase; |
| end Rbase; |
| |
| ------------- |
| -- Release -- |
| ------------- |
| |
| procedure Release (M : Save_Mark) is |
| begin |
| Ureals.Set_Last (Ureal (M)); |
| end Release; |
| |
| ---------- |
| -- Same -- |
| ---------- |
| |
| function Same (U1, U2 : Ureal) return Boolean is |
| begin |
| return Int (U1) = Int (U2); |
| end Same; |
| |
| ----------------- |
| -- Store_Ureal -- |
| ----------------- |
| |
| function Store_Ureal (Val : Ureal_Entry) return Ureal is |
| begin |
| Ureals.Append (Val); |
| |
| -- Normalize representation of signed values |
| |
| if Val.Num < 0 then |
| Ureals.Table (Ureals.Last).Negative := True; |
| Ureals.Table (Ureals.Last).Num := -Val.Num; |
| end if; |
| |
| return Ureals.Last; |
| end Store_Ureal; |
| |
| ---------------------------- |
| -- Store_Ureal_Normalized -- |
| ---------------------------- |
| |
| function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is |
| begin |
| return Store_Ureal (Normalize (Val)); |
| end Store_Ureal_Normalized; |
| |
| --------------- |
| -- Tree_Read -- |
| --------------- |
| |
| procedure Tree_Read is |
| begin |
| pragma Assert (Num_Ureal_Constants = 10); |
| |
| Ureals.Tree_Read; |
| Tree_Read_Int (Int (UR_0)); |
| Tree_Read_Int (Int (UR_M_0)); |
| Tree_Read_Int (Int (UR_Tenth)); |
| Tree_Read_Int (Int (UR_Half)); |
| Tree_Read_Int (Int (UR_1)); |
| Tree_Read_Int (Int (UR_2)); |
| Tree_Read_Int (Int (UR_10)); |
| Tree_Read_Int (Int (UR_100)); |
| Tree_Read_Int (Int (UR_2_128)); |
| Tree_Read_Int (Int (UR_2_M_128)); |
| |
| -- Clear the normalization cache |
| |
| Normalized_Real := No_Ureal; |
| end Tree_Read; |
| |
| ---------------- |
| -- Tree_Write -- |
| ---------------- |
| |
| procedure Tree_Write is |
| begin |
| pragma Assert (Num_Ureal_Constants = 10); |
| |
| Ureals.Tree_Write; |
| Tree_Write_Int (Int (UR_0)); |
| Tree_Write_Int (Int (UR_M_0)); |
| Tree_Write_Int (Int (UR_Tenth)); |
| Tree_Write_Int (Int (UR_Half)); |
| Tree_Write_Int (Int (UR_1)); |
| Tree_Write_Int (Int (UR_2)); |
| Tree_Write_Int (Int (UR_10)); |
| Tree_Write_Int (Int (UR_100)); |
| Tree_Write_Int (Int (UR_2_128)); |
| Tree_Write_Int (Int (UR_2_M_128)); |
| end Tree_Write; |
| |
| ------------ |
| -- UR_Abs -- |
| ------------ |
| |
| function UR_Abs (Real : Ureal) return Ureal is |
| Val : constant Ureal_Entry := Ureals.Table (Real); |
| |
| begin |
| return Store_Ureal |
| ((Num => Val.Num, |
| Den => Val.Den, |
| Rbase => Val.Rbase, |
| Negative => False)); |
| end UR_Abs; |
| |
| ------------ |
| -- UR_Add -- |
| ------------ |
| |
| function UR_Add (Left : Uint; Right : Ureal) return Ureal is |
| begin |
| return UR_From_Uint (Left) + Right; |
| end UR_Add; |
| |
| function UR_Add (Left : Ureal; Right : Uint) return Ureal is |
| begin |
| return Left + UR_From_Uint (Right); |
| end UR_Add; |
| |
| function UR_Add (Left : Ureal; Right : Ureal) return Ureal is |
| Lval : Ureal_Entry := Ureals.Table (Left); |
| Rval : Ureal_Entry := Ureals.Table (Right); |
| Num : Uint; |
| |
| begin |
| -- Note, in the temporary Ureal_Entry values used in this procedure, |
| -- we store the sign as the sign of the numerator (i.e. xxx.Num may |
| -- be negative, even though in stored entries this can never be so) |
| |
| if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then |
| declare |
| Opd_Min, Opd_Max : Ureal_Entry; |
| Exp_Min, Exp_Max : Uint; |
| |
| begin |
| if Lval.Negative then |
| Lval.Num := (-Lval.Num); |
| end if; |
| |
| if Rval.Negative then |
| Rval.Num := (-Rval.Num); |
| end if; |
| |
| if Lval.Den < Rval.Den then |
| Exp_Min := Lval.Den; |
| Exp_Max := Rval.Den; |
| Opd_Min := Lval; |
| Opd_Max := Rval; |
| else |
| Exp_Min := Rval.Den; |
| Exp_Max := Lval.Den; |
| Opd_Min := Rval; |
| Opd_Max := Lval; |
| end if; |
| |
| Num := |
| Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num; |
| |
| if Num = 0 then |
| return Store_Ureal |
| ((Num => Uint_0, |
| Den => Uint_1, |
| Rbase => 0, |
| Negative => Lval.Negative)); |
| |
| else |
| return Store_Ureal |
| ((Num => abs Num, |
| Den => Exp_Max, |
| Rbase => Lval.Rbase, |
| Negative => (Num < 0))); |
| end if; |
| end; |
| |
| else |
| declare |
| Ln : Ureal_Entry := Normalize (Lval); |
| Rn : Ureal_Entry := Normalize (Rval); |
| |
| begin |
| if Ln.Negative then |
| Ln.Num := (-Ln.Num); |
| end if; |
| |
| if Rn.Negative then |
| Rn.Num := (-Rn.Num); |
| end if; |
| |
| Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den); |
| |
| if Num = 0 then |
| return Store_Ureal |
| ((Num => Uint_0, |
| Den => Uint_1, |
| Rbase => 0, |
| Negative => Lval.Negative)); |
| |
| else |
| return Store_Ureal_Normalized |
| ((Num => abs Num, |
| Den => Ln.Den * Rn.Den, |
| Rbase => 0, |
| Negative => (Num < 0))); |
| end if; |
| end; |
| end if; |
| end UR_Add; |
| |
| ---------------- |
| -- UR_Ceiling -- |
| ---------------- |
| |
| function UR_Ceiling (Real : Ureal) return Uint is |
| Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); |
| begin |
| if Val.Negative then |
| return UI_Negate (Val.Num / Val.Den); |
| else |
| return (Val.Num + Val.Den - 1) / Val.Den; |
| end if; |
| end UR_Ceiling; |
| |
| ------------ |
| -- UR_Div -- |
| ------------ |
| |
| function UR_Div (Left : Uint; Right : Ureal) return Ureal is |
| begin |
| return UR_From_Uint (Left) / Right; |
| end UR_Div; |
| |
| function UR_Div (Left : Ureal; Right : Uint) return Ureal is |
| begin |
| return Left / UR_From_Uint (Right); |
| end UR_Div; |
| |
| function UR_Div (Left, Right : Ureal) return Ureal is |
| Lval : constant Ureal_Entry := Ureals.Table (Left); |
| Rval : constant Ureal_Entry := Ureals.Table (Right); |
| Rneg : constant Boolean := Rval.Negative xor Lval.Negative; |
| |
| begin |
| pragma Assert (Rval.Num /= Uint_0); |
| |
| if Lval.Rbase = 0 then |
| if Rval.Rbase = 0 then |
| return Store_Ureal_Normalized |
| ((Num => Lval.Num * Rval.Den, |
| Den => Lval.Den * Rval.Num, |
| Rbase => 0, |
| Negative => Rneg)); |
| |
| elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then |
| return Store_Ureal |
| ((Num => Lval.Num / (Rval.Num * Lval.Den), |
| Den => (-Rval.Den), |
| Rbase => Rval.Rbase, |
| Negative => Rneg)); |
| |
| elsif Rval.Den < 0 then |
| return Store_Ureal_Normalized |
| ((Num => Lval.Num, |
| Den => Rval.Rbase ** (-Rval.Den) * |
| Rval.Num * |
| Lval.Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| |
| else |
| return Store_Ureal_Normalized |
| ((Num => Lval.Num * Rval.Rbase ** Rval.Den, |
| Den => Rval.Num * Lval.Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| end if; |
| |
| elsif Is_Integer (Lval.Num, Rval.Num) then |
| if Rval.Rbase = Lval.Rbase then |
| return Store_Ureal |
| ((Num => Lval.Num / Rval.Num, |
| Den => Lval.Den - Rval.Den, |
| Rbase => Lval.Rbase, |
| Negative => Rneg)); |
| |
| elsif Rval.Rbase = 0 then |
| return Store_Ureal |
| ((Num => (Lval.Num / Rval.Num) * Rval.Den, |
| Den => Lval.Den, |
| Rbase => Lval.Rbase, |
| Negative => Rneg)); |
| |
| elsif Rval.Den < 0 then |
| declare |
| Num, Den : Uint; |
| |
| begin |
| if Lval.Den < 0 then |
| Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den)); |
| Den := Rval.Rbase ** (-Rval.Den); |
| else |
| Num := Lval.Num / Rval.Num; |
| Den := (Lval.Rbase ** Lval.Den) * |
| (Rval.Rbase ** (-Rval.Den)); |
| end if; |
| |
| return Store_Ureal |
| ((Num => Num, |
| Den => Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| end; |
| |
| else |
| return Store_Ureal |
| ((Num => (Lval.Num / Rval.Num) * |
| (Rval.Rbase ** Rval.Den), |
| Den => Lval.Den, |
| Rbase => Lval.Rbase, |
| Negative => Rneg)); |
| end if; |
| |
| else |
| declare |
| Num, Den : Uint; |
| |
| begin |
| if Lval.Den < 0 then |
| Num := Lval.Num * (Lval.Rbase ** (-Lval.Den)); |
| Den := Rval.Num; |
| else |
| Num := Lval.Num; |
| Den := Rval.Num * (Lval.Rbase ** Lval.Den); |
| end if; |
| |
| if Rval.Rbase /= 0 then |
| if Rval.Den < 0 then |
| Den := Den * (Rval.Rbase ** (-Rval.Den)); |
| else |
| Num := Num * (Rval.Rbase ** Rval.Den); |
| end if; |
| |
| else |
| Num := Num * Rval.Den; |
| end if; |
| |
| return Store_Ureal_Normalized |
| ((Num => Num, |
| Den => Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| end; |
| end if; |
| end UR_Div; |
| |
| ----------- |
| -- UR_Eq -- |
| ----------- |
| |
| function UR_Eq (Left, Right : Ureal) return Boolean is |
| begin |
| return not UR_Ne (Left, Right); |
| end UR_Eq; |
| |
| --------------------- |
| -- UR_Exponentiate -- |
| --------------------- |
| |
| function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is |
| X : constant Uint := abs N; |
| Bas : Ureal; |
| Val : Ureal_Entry; |
| Neg : Boolean; |
| IBas : Uint; |
| |
| begin |
| -- If base is negative, then the resulting sign depends on whether |
| -- the exponent is even or odd (even => positive, odd = negative) |
| |
| if UR_Is_Negative (Real) then |
| Neg := (N mod 2) /= 0; |
| Bas := UR_Negate (Real); |
| else |
| Neg := False; |
| Bas := Real; |
| end if; |
| |
| Val := Ureals.Table (Bas); |
| |
| -- If the base is a small integer, then we can return the result in |
| -- exponential form, which can save a lot of time for junk exponents. |
| |
| IBas := UR_Trunc (Bas); |
| |
| if IBas <= 16 |
| and then UR_From_Uint (IBas) = Bas |
| then |
| return Store_Ureal |
| ((Num => Uint_1, |
| Den => -N, |
| Rbase => UI_To_Int (UR_Trunc (Bas)), |
| Negative => Neg)); |
| |
| -- If the exponent is negative then we raise the numerator and the |
| -- denominator (after normalization) to the absolute value of the |
| -- exponent and we return the reciprocal. An assert error will happen |
| -- if the numerator is zero. |
| |
| elsif N < 0 then |
| pragma Assert (Val.Num /= 0); |
| Val := Normalize (Val); |
| |
| return Store_Ureal |
| ((Num => Val.Den ** X, |
| Den => Val.Num ** X, |
| Rbase => 0, |
| Negative => Neg)); |
| |
| -- If positive, we distinguish the case when the base is not zero, in |
| -- which case the new denominator is just the product of the old one |
| -- with the exponent, |
| |
| else |
| if Val.Rbase /= 0 then |
| |
| return Store_Ureal |
| ((Num => Val.Num ** X, |
| Den => Val.Den * X, |
| Rbase => Val.Rbase, |
| Negative => Neg)); |
| |
| -- And when the base is zero, in which case we exponentiate |
| -- the old denominator. |
| |
| else |
| return Store_Ureal |
| ((Num => Val.Num ** X, |
| Den => Val.Den ** X, |
| Rbase => 0, |
| Negative => Neg)); |
| end if; |
| end if; |
| end UR_Exponentiate; |
| |
| -------------- |
| -- UR_Floor -- |
| -------------- |
| |
| function UR_Floor (Real : Ureal) return Uint is |
| Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); |
| begin |
| if Val.Negative then |
| return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den); |
| else |
| return Val.Num / Val.Den; |
| end if; |
| end UR_Floor; |
| |
| ------------------------ |
| -- UR_From_Components -- |
| ------------------------ |
| |
| function UR_From_Components |
| (Num : Uint; |
| Den : Uint; |
| Rbase : Nat := 0; |
| Negative : Boolean := False) |
| return Ureal |
| is |
| begin |
| return Store_Ureal |
| ((Num => Num, |
| Den => Den, |
| Rbase => Rbase, |
| Negative => Negative)); |
| end UR_From_Components; |
| |
| ------------------ |
| -- UR_From_Uint -- |
| ------------------ |
| |
| function UR_From_Uint (UI : Uint) return Ureal is |
| begin |
| return UR_From_Components |
| (abs UI, Uint_1, Negative => (UI < 0)); |
| end UR_From_Uint; |
| |
| ----------- |
| -- UR_Ge -- |
| ----------- |
| |
| function UR_Ge (Left, Right : Ureal) return Boolean is |
| begin |
| return not (Left < Right); |
| end UR_Ge; |
| |
| ----------- |
| -- UR_Gt -- |
| ----------- |
| |
| function UR_Gt (Left, Right : Ureal) return Boolean is |
| begin |
| return (Right < Left); |
| end UR_Gt; |
| |
| -------------------- |
| -- UR_Is_Negative -- |
| -------------------- |
| |
| function UR_Is_Negative (Real : Ureal) return Boolean is |
| begin |
| return Ureals.Table (Real).Negative; |
| end UR_Is_Negative; |
| |
| -------------------- |
| -- UR_Is_Positive -- |
| -------------------- |
| |
| function UR_Is_Positive (Real : Ureal) return Boolean is |
| begin |
| return not Ureals.Table (Real).Negative |
| and then Ureals.Table (Real).Num /= 0; |
| end UR_Is_Positive; |
| |
| ---------------- |
| -- UR_Is_Zero -- |
| ---------------- |
| |
| function UR_Is_Zero (Real : Ureal) return Boolean is |
| begin |
| return Ureals.Table (Real).Num = 0; |
| end UR_Is_Zero; |
| |
| ----------- |
| -- UR_Le -- |
| ----------- |
| |
| function UR_Le (Left, Right : Ureal) return Boolean is |
| begin |
| return not (Right < Left); |
| end UR_Le; |
| |
| ----------- |
| -- UR_Lt -- |
| ----------- |
| |
| function UR_Lt (Left, Right : Ureal) return Boolean is |
| begin |
| -- An operand is not less than itself |
| |
| if Same (Left, Right) then |
| return False; |
| |
| -- Deal with zero cases |
| |
| elsif UR_Is_Zero (Left) then |
| return UR_Is_Positive (Right); |
| |
| elsif UR_Is_Zero (Right) then |
| return Ureals.Table (Left).Negative; |
| |
| -- Different signs are decisive (note we dealt with zero cases) |
| |
| elsif Ureals.Table (Left).Negative |
| and then not Ureals.Table (Right).Negative |
| then |
| return True; |
| |
| elsif not Ureals.Table (Left).Negative |
| and then Ureals.Table (Right).Negative |
| then |
| return False; |
| |
| -- Signs are same, do rapid check based on worst case estimates of |
| -- decimal exponent, which will often be decisive. Precise test |
| -- depends on whether operands are positive or negative. |
| |
| elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then |
| return UR_Is_Positive (Left); |
| |
| elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then |
| return UR_Is_Negative (Left); |
| |
| -- If we fall through, full gruesome test is required. This happens |
| -- if the numbers are close together, or in some weird (/=10) base. |
| |
| else |
| declare |
| Imrk : constant Uintp.Save_Mark := Mark; |
| Rmrk : constant Urealp.Save_Mark := Mark; |
| Lval : Ureal_Entry; |
| Rval : Ureal_Entry; |
| Result : Boolean; |
| |
| begin |
| Lval := Ureals.Table (Left); |
| Rval := Ureals.Table (Right); |
| |
| -- An optimization. If both numbers are based, then subtract |
| -- common value of base to avoid unnecessarily giant numbers |
| |
| if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then |
| if Lval.Den < Rval.Den then |
| Rval.Den := Rval.Den - Lval.Den; |
| Lval.Den := Uint_0; |
| else |
| Lval.Den := Lval.Den - Rval.Den; |
| Rval.Den := Uint_0; |
| end if; |
| end if; |
| |
| Lval := Normalize (Lval); |
| Rval := Normalize (Rval); |
| |
| if Lval.Negative then |
| Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den); |
| else |
| Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den); |
| end if; |
| |
| Release (Imrk); |
| Release (Rmrk); |
| return Result; |
| end; |
| end if; |
| end UR_Lt; |
| |
| ------------ |
| -- UR_Max -- |
| ------------ |
| |
| function UR_Max (Left, Right : Ureal) return Ureal is |
| begin |
| if Left >= Right then |
| return Left; |
| else |
| return Right; |
| end if; |
| end UR_Max; |
| |
| ------------ |
| -- UR_Min -- |
| ------------ |
| |
| function UR_Min (Left, Right : Ureal) return Ureal is |
| begin |
| if Left <= Right then |
| return Left; |
| else |
| return Right; |
| end if; |
| end UR_Min; |
| |
| ------------ |
| -- UR_Mul -- |
| ------------ |
| |
| function UR_Mul (Left : Uint; Right : Ureal) return Ureal is |
| begin |
| return UR_From_Uint (Left) * Right; |
| end UR_Mul; |
| |
| function UR_Mul (Left : Ureal; Right : Uint) return Ureal is |
| begin |
| return Left * UR_From_Uint (Right); |
| end UR_Mul; |
| |
| function UR_Mul (Left, Right : Ureal) return Ureal is |
| Lval : constant Ureal_Entry := Ureals.Table (Left); |
| Rval : constant Ureal_Entry := Ureals.Table (Right); |
| Num : Uint := Lval.Num * Rval.Num; |
| Den : Uint; |
| Rneg : constant Boolean := Lval.Negative xor Rval.Negative; |
| |
| begin |
| if Lval.Rbase = 0 then |
| if Rval.Rbase = 0 then |
| return Store_Ureal_Normalized |
| ((Num => Num, |
| Den => Lval.Den * Rval.Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| |
| elsif Is_Integer (Num, Lval.Den) then |
| return Store_Ureal |
| ((Num => Num / Lval.Den, |
| Den => Rval.Den, |
| Rbase => Rval.Rbase, |
| Negative => Rneg)); |
| |
| elsif Rval.Den < 0 then |
| return Store_Ureal_Normalized |
| ((Num => Num * (Rval.Rbase ** (-Rval.Den)), |
| Den => Lval.Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| |
| else |
| return Store_Ureal_Normalized |
| ((Num => Num, |
| Den => Lval.Den * (Rval.Rbase ** Rval.Den), |
| Rbase => 0, |
| Negative => Rneg)); |
| end if; |
| |
| elsif Lval.Rbase = Rval.Rbase then |
| return Store_Ureal |
| ((Num => Num, |
| Den => Lval.Den + Rval.Den, |
| Rbase => Lval.Rbase, |
| Negative => Rneg)); |
| |
| elsif Rval.Rbase = 0 then |
| if Is_Integer (Num, Rval.Den) then |
| return Store_Ureal |
| ((Num => Num / Rval.Den, |
| Den => Lval.Den, |
| Rbase => Lval.Rbase, |
| Negative => Rneg)); |
| |
| elsif Lval.Den < 0 then |
| return Store_Ureal_Normalized |
| ((Num => Num * (Lval.Rbase ** (-Lval.Den)), |
| Den => Rval.Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| |
| else |
| return Store_Ureal_Normalized |
| ((Num => Num, |
| Den => Rval.Den * (Lval.Rbase ** Lval.Den), |
| Rbase => 0, |
| Negative => Rneg)); |
| end if; |
| |
| else |
| Den := Uint_1; |
| |
| if Lval.Den < 0 then |
| Num := Num * (Lval.Rbase ** (-Lval.Den)); |
| else |
| Den := Den * (Lval.Rbase ** Lval.Den); |
| end if; |
| |
| if Rval.Den < 0 then |
| Num := Num * (Rval.Rbase ** (-Rval.Den)); |
| else |
| Den := Den * (Rval.Rbase ** Rval.Den); |
| end if; |
| |
| return Store_Ureal_Normalized |
| ((Num => Num, |
| Den => Den, |
| Rbase => 0, |
| Negative => Rneg)); |
| end if; |
| end UR_Mul; |
| |
| ----------- |
| -- UR_Ne -- |
| ----------- |
| |
| function UR_Ne (Left, Right : Ureal) return Boolean is |
| begin |
| -- Quick processing for case of identical Ureal values (note that |
| -- this also deals with comparing two No_Ureal values). |
| |
| if Same (Left, Right) then |
| return False; |
| |
| -- Deal with case of one or other operand is No_Ureal, but not both |
| |
| elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then |
| return True; |
| |
| -- Do quick check based on number of decimal digits |
| |
| elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else |
| Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) |
| then |
| return True; |
| |
| -- Otherwise full comparison is required |
| |
| else |
| declare |
| Imrk : constant Uintp.Save_Mark := Mark; |
| Rmrk : constant Urealp.Save_Mark := Mark; |
| Lval : constant Ureal_Entry := Normalize (Ureals.Table (Left)); |
| Rval : constant Ureal_Entry := Normalize (Ureals.Table (Right)); |
| Result : Boolean; |
| |
| begin |
| if UR_Is_Zero (Left) then |
| return not UR_Is_Zero (Right); |
| |
| elsif UR_Is_Zero (Right) then |
| return not UR_Is_Zero (Left); |
| |
| -- Both operands are non-zero |
| |
| else |
| Result := |
| Rval.Negative /= Lval.Negative |
| or else Rval.Num /= Lval.Num |
| or else Rval.Den /= Lval.Den; |
| Release (Imrk); |
| Release (Rmrk); |
| return Result; |
| end if; |
| end; |
| end if; |
| end UR_Ne; |
| |
| --------------- |
| -- UR_Negate -- |
| --------------- |
| |
| function UR_Negate (Real : Ureal) return Ureal is |
| begin |
| return Store_Ureal |
| ((Num => Ureals.Table (Real).Num, |
| Den => Ureals.Table (Real).Den, |
| Rbase => Ureals.Table (Real).Rbase, |
| Negative => not Ureals.Table (Real).Negative)); |
| end UR_Negate; |
| |
| ------------ |
| -- UR_Sub -- |
| ------------ |
| |
| function UR_Sub (Left : Uint; Right : Ureal) return Ureal is |
| begin |
| return UR_From_Uint (Left) + UR_Negate (Right); |
| end UR_Sub; |
| |
| function UR_Sub (Left : Ureal; Right : Uint) return Ureal is |
| begin |
| return Left + UR_From_Uint (-Right); |
| end UR_Sub; |
| |
| function UR_Sub (Left, Right : Ureal) return Ureal is |
| begin |
| return Left + UR_Negate (Right); |
| end UR_Sub; |
| |
| ---------------- |
| -- UR_To_Uint -- |
| ---------------- |
| |
| function UR_To_Uint (Real : Ureal) return Uint is |
| Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); |
| Res : Uint; |
| |
| begin |
| Res := (Val.Num + (Val.Den / 2)) / Val.Den; |
| |
| if Val.Negative then |
| return UI_Negate (Res); |
| else |
| return Res; |
| end if; |
| end UR_To_Uint; |
| |
| -------------- |
| -- UR_Trunc -- |
| -------------- |
| |
| function UR_Trunc (Real : Ureal) return Uint is |
| Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); |
| begin |
| if Val.Negative then |
| return -(Val.Num / Val.Den); |
| else |
| return Val.Num / Val.Den; |
| end if; |
| end UR_Trunc; |
| |
| -------------- |
| -- UR_Write -- |
| -------------- |
| |
| procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is |
| Val : constant Ureal_Entry := Ureals.Table (Real); |
| T : Uint; |
| |
| begin |
| -- If value is negative, we precede the constant by a minus sign |
| |
| if Val.Negative then |
| Write_Char ('-'); |
| end if; |
| |
| -- Zero is zero |
| |
| if Val.Num = 0 then |
| Write_Str ("0.0"); |
| |
| -- For constants with a denominator of zero, the value is simply the |
| -- numerator value, since we are dividing by base**0, which is 1. |
| |
| elsif Val.Den = 0 then |
| UI_Write (Val.Num, Decimal); |
| Write_Str (".0"); |
| |
| -- Small powers of 2 get written in decimal fixed-point format |
| |
| elsif Val.Rbase = 2 |
| and then Val.Den <= 3 |
| and then Val.Den >= -16 |
| then |
| if Val.Den = 1 then |
| T := Val.Num * (10 / 2); |
| UI_Write (T / 10, Decimal); |
| Write_Char ('.'); |
| UI_Write (T mod 10, Decimal); |
| |
| elsif Val.Den = 2 then |
| T := Val.Num * (100 / 4); |
| UI_Write (T / 100, Decimal); |
| Write_Char ('.'); |
| UI_Write (T mod 100 / 10, Decimal); |
| |
| if T mod 10 /= 0 then |
| UI_Write (T mod 10, Decimal); |
| end if; |
| |
| elsif Val.Den = 3 then |
| T := Val.Num * (1000 / 8); |
| UI_Write (T / 1000, Decimal); |
| Write_Char ('.'); |
| UI_Write (T mod 1000 / 100, Decimal); |
| |
| if T mod 100 /= 0 then |
| UI_Write (T mod 100 / 10, Decimal); |
| |
| if T mod 10 /= 0 then |
| UI_Write (T mod 10, Decimal); |
| end if; |
| end if; |
| |
| else |
| UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal); |
| Write_Str (".0"); |
| end if; |
| |
| -- Constants in base 10 or 16 can be written in normal Ada literal |
| -- style, as long as they fit in the UI_Image_Buffer. Using hexadecimal |
| -- notation, 4 bytes are required for the 16# # part, and every fifth |
| -- character is an underscore. So, a buffer of size N has room for |
| -- ((N - 4) - (N - 4) / 5) * 4 bits, |
| -- or at least |
| -- N * 16 / 5 - 12 bits. |
| |
| elsif (Val.Rbase = 10 or else Val.Rbase = 16) |
| and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12 |
| then |
| pragma Assert (Val.Den /= 0); |
| |
| -- Use fixed-point format for small scaling values |
| |
| if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3) |
| or else (Val.Rbase = 16 and then Val.Den = -1) |
| then |
| UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal); |
| Write_Str (".0"); |
| |
| -- Write hexadecimal constants in exponential notation with a zero |
| -- unit digit. This matches the Ada canonical form for floating point |
| -- numbers, and also ensures that the underscores end up in the |
| -- correct place. |
| |
| elsif Val.Rbase = 16 then |
| UI_Image (Val.Num, Hex); |
| pragma Assert (Val.Rbase = 16); |
| |
| Write_Str ("16#0."); |
| Write_Str (UI_Image_Buffer (4 .. UI_Image_Length)); |
| |
| -- For exponent, exclude 16# # and underscores from length |
| |
| UI_Image_Length := UI_Image_Length - 4; |
| UI_Image_Length := UI_Image_Length - UI_Image_Length / 5; |
| |
| Write_Char ('E'); |
| UI_Write (Int (UI_Image_Length) - Val.Den, Decimal); |
| |
| elsif Val.Den = 1 then |
| UI_Write (Val.Num / 10, Decimal); |
| Write_Char ('.'); |
| UI_Write (Val.Num mod 10, Decimal); |
| |
| elsif Val.Den = 2 then |
| UI_Write (Val.Num / 100, Decimal); |
| Write_Char ('.'); |
| UI_Write (Val.Num / 10 mod 10, Decimal); |
| UI_Write (Val.Num mod 10, Decimal); |
| |
| -- Else use decimal exponential format |
| |
| else |
| -- Write decimal constants with a non-zero unit digit. This |
| -- matches usual scientific notation. |
| |
| UI_Image (Val.Num, Decimal); |
| Write_Char (UI_Image_Buffer (1)); |
| Write_Char ('.'); |
| |
| if UI_Image_Length = 1 then |
| Write_Char ('0'); |
| else |
| Write_Str (UI_Image_Buffer (2 .. UI_Image_Length)); |
| end if; |
| |
| Write_Char ('E'); |
| UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal); |
| end if; |
| |
| -- Constants in a base other than 10 can still be easily written in |
| -- normal Ada literal style if the numerator is one. |
| |
| elsif Val.Rbase /= 0 and then Val.Num = 1 then |
| Write_Int (Val.Rbase); |
| Write_Str ("#1.0#E"); |
| UI_Write (-Val.Den); |
| |
| -- Other constants with a base other than 10 are written using one |
| -- of the following forms, depending on the sign of the number |
| -- and the sign of the exponent (= minus denominator value) |
| |
| -- numerator.0*base**exponent |
| -- numerator.0*base**-exponent |
| |
| -- And of course an exponent of 0 can be omitted |
| |
| elsif Val.Rbase /= 0 then |
| if Brackets then |
| Write_Char ('['); |
| end if; |
| |
| UI_Write (Val.Num, Decimal); |
| Write_Str (".0"); |
| |
| if Val.Den /= 0 then |
| Write_Char ('*'); |
| Write_Int (Val.Rbase); |
| Write_Str ("**"); |
| |
| if Val.Den <= 0 then |
| UI_Write (-Val.Den, Decimal); |
| else |
| Write_Str ("(-"); |
| UI_Write (Val.Den, Decimal); |
| Write_Char (')'); |
| end if; |
| end if; |
| |
| if Brackets then |
| Write_Char (']'); |
| end if; |
| |
| -- Rationals where numerator is divisible by denominator can be output |
| -- as literals after we do the division. This includes the common case |
| -- where the denominator is 1. |
| |
| elsif Val.Num mod Val.Den = 0 then |
| UI_Write (Val.Num / Val.Den, Decimal); |
| Write_Str (".0"); |
| |
| -- Other non-based (rational) constants are written in num/den style |
| |
| else |
| if Brackets then |
| Write_Char ('['); |
| end if; |
| |
| UI_Write (Val.Num, Decimal); |
| Write_Str (".0/"); |
| UI_Write (Val.Den, Decimal); |
| Write_Str (".0"); |
| |
| if Brackets then |
| Write_Char (']'); |
| end if; |
| end if; |
| end UR_Write; |
| |
| ------------- |
| -- Ureal_0 -- |
| ------------- |
| |
| function Ureal_0 return Ureal is |
| begin |
| return UR_0; |
| end Ureal_0; |
| |
| ------------- |
| -- Ureal_1 -- |
| ------------- |
| |
| function Ureal_1 return Ureal is |
| begin |
| return UR_1; |
| end Ureal_1; |
| |
| ------------- |
| -- Ureal_2 -- |
| ------------- |
| |
| function Ureal_2 return Ureal is |
| begin |
| return UR_2; |
| end Ureal_2; |
| |
| -------------- |
| -- Ureal_10 -- |
| -------------- |
| |
| function Ureal_10 return Ureal is |
| begin |
| return UR_10; |
| end Ureal_10; |
| |
| --------------- |
| -- Ureal_100 -- |
| --------------- |
| |
| function Ureal_100 return Ureal is |
| begin |
| return UR_100; |
| end Ureal_100; |
| |
| ----------------- |
| -- Ureal_10_36 -- |
| ----------------- |
| |
| function Ureal_10_36 return Ureal is |
| begin |
| return UR_10_36; |
| end Ureal_10_36; |
| |
| ---------------- |
| -- Ureal_2_80 -- |
| ---------------- |
| |
| function Ureal_2_80 return Ureal is |
| begin |
| return UR_2_80; |
| end Ureal_2_80; |
| |
| ----------------- |
| -- Ureal_2_128 -- |
| ----------------- |
| |
| function Ureal_2_128 return Ureal is |
| begin |
| return UR_2_128; |
| end Ureal_2_128; |
| |
| ------------------- |
| -- Ureal_2_M_80 -- |
| ------------------- |
| |
| function Ureal_2_M_80 return Ureal is |
| begin |
| return UR_2_M_80; |
| end Ureal_2_M_80; |
| |
| ------------------- |
| -- Ureal_2_M_128 -- |
| ------------------- |
| |
| function Ureal_2_M_128 return Ureal is |
| begin |
| return UR_2_M_128; |
| end Ureal_2_M_128; |
| |
| ---------------- |
| -- Ureal_Half -- |
| ---------------- |
| |
| function Ureal_Half return Ureal is |
| begin |
| return UR_Half; |
| end Ureal_Half; |
| |
| --------------- |
| -- Ureal_M_0 -- |
| --------------- |
| |
| function Ureal_M_0 return Ureal is |
| begin |
| return UR_M_0; |
| end Ureal_M_0; |
| |
| ------------------- |
| -- Ureal_M_10_36 -- |
| ------------------- |
| |
| function Ureal_M_10_36 return Ureal is |
| begin |
| return UR_M_10_36; |
| end Ureal_M_10_36; |
| |
| ----------------- |
| -- Ureal_Tenth -- |
| ----------------- |
| |
| function Ureal_Tenth return Ureal is |
| begin |
| return UR_Tenth; |
| end Ureal_Tenth; |
| |
| end Urealp; |
