gcc/ada/urealp.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               U R E A L P                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   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 with Alloc;
  27 with Output; use Output;
  28 with Table;
  29
  30 package body Urealp is
  31
  32    Ureal_First_Entry : constant Ureal := Ureal'Succ (No_Ureal);
  33    --  First subscript allocated in Ureal table (note that we can't just
  34    --  add 1 to No_Ureal, since "+" means something different for Ureals).
  35
  36    type Ureal_Entry is record
  37       Num  : Uint;
  38       --  Numerator (always non-negative)
  39
  40       Den : Uint;
  41       --  Denominator (always non-zero, always positive if base is zero)
  42
  43       Rbase : Nat;
  44       --  Base value. If Rbase is zero, then the value is simply Num / Den.
  45       --  If Rbase is non-zero, then the value is Num / (Rbase ** Den)
  46
  47       Negative : Boolean;
  48       --  Flag set if value is negative
  49    end record;
  50
  51    --  The following representation clause ensures that the above record
  52    --  has no holes. We do this so that when instances of this record are
  53    --  written, we do not write uninitialized values to the file.
  54
  55    for Ureal_Entry use record
  56       Num      at  0 range 0 .. 31;
  57       Den      at  4 range 0 .. 31;
  58       Rbase    at  8 range 0 .. 31;
  59       Negative at 12 range 0 .. 31;
  60    end record;
  61
  62    for Ureal_Entry'Size use 16 * 8;
  63    --  This ensures that we did not leave out any fields
  64
  65    package Ureals is new Table.Table (
  66      Table_Component_Type => Ureal_Entry,
  67      Table_Index_Type     => Ureal'Base,
  68      Table_Low_Bound      => Ureal_First_Entry,
  69      Table_Initial        => Alloc.Ureals_Initial,
  70      Table_Increment      => Alloc.Ureals_Increment,
  71      Table_Name           => "Ureals");
  72
  73    --  The following universal reals are the values returned by the constant
  74    --  functions. They are initialized by the initialization procedure.
  75
  76    UR_0         : Ureal;
  77    UR_M_0       : Ureal;
  78    UR_Tenth     : Ureal;
  79    UR_Half      : Ureal;
  80    UR_1         : Ureal;
  81    UR_2         : Ureal;
  82    UR_10        : Ureal;
  83    UR_2_10_18   : Ureal;
  84    UR_9_10_36   : Ureal;
  85    UR_10_76     : Ureal;
  86    UR_M_2_10_18 : Ureal;
  87    UR_M_9_10_36 : Ureal;
  88    UR_M_10_76   : Ureal;
  89    UR_100       : Ureal;
  90    UR_2_127     : Ureal;
  91    UR_2_128     : Ureal;
  92    UR_2_31      : Ureal;
  93    UR_2_63      : Ureal;
  94    UR_2_80      : Ureal;
  95    UR_2_M_127   : Ureal;
  96    UR_2_M_128   : Ureal;
  97    UR_2_M_80    : Ureal;
  98
  99    Normalized_Real : Ureal := No_Ureal;
 100    --  Used to memoize Norm_Num and Norm_Den, if either of these functions
 101    --  is called, this value is set and Normalized_Entry contains the result
 102    --  of the normalization. On subsequent calls, this is used to avoid the
 103    --  call to Normalize if it has already been made.
 104
 105    Normalized_Entry : Ureal_Entry;
 106    --  Entry built by most recent call to Normalize
 107
 108    -----------------------
 109    -- Local Subprograms --
 110    -----------------------
 111
 112    function Decimal_Exponent_Hi (V : Ureal) return Int;
 113    --  Returns an estimate of the exponent of Val represented as a normalized
 114    --  decimal number (non-zero digit before decimal point), the estimate is
 115    --  either correct, or high, but never low. The accuracy of the estimate
 116    --  affects only the efficiency of the comparison routines.
 117
 118    function Decimal_Exponent_Lo (V : Ureal) return Int;
 119    --  Returns an estimate of the exponent of Val represented as a normalized
 120    --  decimal number (non-zero digit before decimal point), the estimate is
 121    --  either correct, or low, but never high. The accuracy of the estimate
 122    --  affects only the efficiency of the comparison routines.
 123
 124    function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int;
 125    --  U is a Ureal entry for which the base value is non-zero, the value
 126    --  returned is the equivalent decimal exponent value, i.e. the value of
 127    --  Den, adjusted as though the base were base 10. The value is rounded
 128    --  toward zero (truncated), and so its value can be off by one.
 129
 130    function Is_Integer (Num, Den : Uint) return Boolean;
 131    --  Return true if the real quotient of Num / Den is an integer value
 132
 133    function Normalize (Val : Ureal_Entry) return Ureal_Entry;
 134    --  Normalizes the Ureal_Entry by reducing it to lowest terms (with a base
 135    --  value of 0).
 136
 137    function Same (U1, U2 : Ureal) return Boolean;
 138    pragma Inline (Same);
 139    --  Determines if U1 and U2 are the same Ureal. Note that we cannot use
 140    --  the equals operator for this test, since that tests for equality, not
 141    --  identity.
 142
 143    function Store_Ureal (Val : Ureal_Entry) return Ureal;
 144    --  This store a new entry in the universal reals table and return its index
 145    --  in the table.
 146
 147    function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal;
 148    pragma Inline (Store_Ureal_Normalized);
 149    --  Like Store_Ureal, but normalizes its operand first
 150
 151    -------------------------
 152    -- Decimal_Exponent_Hi --
 153    -------------------------
 154
 155    function Decimal_Exponent_Hi (V : Ureal) return Int is
 156       Val : constant Ureal_Entry := Ureals.Table (V);
 157
 158    begin
 159       --  Zero always returns zero
 160
 161       if UR_Is_Zero (V) then
 162          return 0;
 163
 164       --  For numbers in rational form, get the maximum number of digits in the
 165       --  numerator and the minimum number of digits in the denominator, and
 166       --  subtract. For example:
 167
 168       --     1000 / 99 = 1.010E+1
 169       --     9999 / 10 = 9.999E+2
 170
 171       --  This estimate may of course be high, but that is acceptable
 172
 173       elsif Val.Rbase = 0 then
 174          return UI_Decimal_Digits_Hi (Val.Num) -
 175                 UI_Decimal_Digits_Lo (Val.Den);
 176
 177       --  For based numbers, get the maximum number of digits in the numerator
 178       --  minus one and the either exact or floor value of the decimal exponent
 179       --  of the denominator, and subtract. For example:
 180
 181       --      321 / 10**3 = 3.21E-1
 182       --      435 / 5**7  = 5.57E-3
 183
 184       else
 185          declare
 186             E : Int;
 187
 188          begin
 189             if Val.Rbase = 10 then
 190                E := UI_To_Int (Val.Den);
 191
 192             else
 193                E := Equivalent_Decimal_Exponent (Val);
 194                if E < 0 then
 195                   E := E - 1;
 196                end if;
 197             end if;
 198
 199             return UI_Decimal_Digits_Hi (Val.Num) - 1 - E;
 200          end;
 201       end if;
 202    end Decimal_Exponent_Hi;
 203
 204    -------------------------
 205    -- Decimal_Exponent_Lo --
 206    -------------------------
 207
 208    function Decimal_Exponent_Lo (V : Ureal) return Int is
 209       Val : constant Ureal_Entry := Ureals.Table (V);
 210
 211    begin
 212       --  Zero always returns zero
 213
 214       if UR_Is_Zero (V) then
 215          return 0;
 216
 217       --  For numbers in rational form, get min digits in numerator, max digits
 218       --  in denominator, and subtract and subtract one more for possible loss
 219       --  during the division. For example:
 220
 221       --     1000 / 99 = 1.010E+1
 222       --     9999 / 10 = 9.999E+2
 223
 224       --  This estimate may of course be low, but that is acceptable
 225
 226       elsif Val.Rbase = 0 then
 227          return UI_Decimal_Digits_Lo (Val.Num) -
 228                 UI_Decimal_Digits_Hi (Val.Den) - 1;
 229
 230       --  For based numbers, get the minimum number of digits in the numerator
 231       --  minus one and the either exact or ceil value of the decimal exponent
 232       --  of the denominator, and subtract. For example:
 233
 234       --      321 / 10**3 = 3.21E-1
 235       --      435 / 5**7  = 5.57E-3
 236
 237       else
 238          declare
 239             E : Int;
 240
 241          begin
 242             if Val.Rbase = 10 then
 243                E := UI_To_Int (Val.Den);
 244
 245             else
 246                E := Equivalent_Decimal_Exponent (Val);
 247                if E > 0 then
 248                   E := E + 1;
 249                end if;
 250             end if;
 251
 252             return UI_Decimal_Digits_Lo (Val.Num) - 1 - E;
 253          end;
 254       end if;
 255    end Decimal_Exponent_Lo;
 256
 257    -----------------
 258    -- Denominator --
 259    -----------------
 260
 261    function Denominator (Real : Ureal) return Uint is
 262    begin
 263       return Ureals.Table (Real).Den;
 264    end Denominator;
 265
 266    ---------------------------------
 267    -- Equivalent_Decimal_Exponent --
 268    ---------------------------------
 269
 270    function Equivalent_Decimal_Exponent (U : Ureal_Entry) return Int is
 271
 272       type Ratio is record
 273          Num : Nat;
 274          Den : Nat;
 275       end record;
 276
 277       --  The following table is a table of logs to the base 10. All values
 278       --  have at least 15 digits of precision, and do not exceed the true
 279       --  value. To avoid the use of floating point, and as a result potential
 280       --  target dependency, each entry is represented as a fraction of two
 281       --  integers.
 282
 283       Logs : constant array (Nat range 1 .. 16) of Ratio :=
 284         (1 => (Num =>           0, Den =>            1),  -- 0
 285          2 => (Num =>  15_392_313, Den =>   51_132_157),  -- 0.301029995663981
 286          3 => (Num => 731_111_920, Den => 1532_339_867),  -- 0.477121254719662
 287          4 => (Num =>  30_784_626, Den =>   51_132_157),  -- 0.602059991327962
 288          5 => (Num => 111_488_153, Den =>  159_503_487),  -- 0.698970004336018
 289          6 => (Num =>  84_253_929, Den =>  108_274_489),  -- 0.778151250383643
 290          7 => (Num =>  35_275_468, Den =>   41_741_273),  -- 0.845098040014256
 291          8 => (Num =>  46_176_939, Den =>   51_132_157),  -- 0.903089986991943
 292          9 => (Num => 417_620_173, Den =>  437_645_744),  -- 0.954242509439324
 293         10 => (Num =>           1, Den =>            1),  -- 1.000000000000000
 294         11 => (Num => 136_507_510, Den =>  131_081_687),  -- 1.041392685158225
 295         12 => (Num =>  26_797_783, Den =>   24_831_587),  -- 1.079181246047624
 296         13 => (Num =>  73_333_297, Den =>   65_832_160),  -- 1.113943352306836
 297         14 => (Num => 102_941_258, Den =>   89_816_543),  -- 1.146128035678238
 298         15 => (Num =>  53_385_559, Den =>   45_392_361),  -- 1.176091259055681
 299         16 => (Num =>  78_897_839, Den =>   65_523_237)); -- 1.204119982655924
 300
 301       function Scale (X : Uint; R : Ratio) return Int;
 302       --  Compute the value of X scaled by R
 303
 304       -----------
 305       -- Scale --
 306       -----------
 307
 308       function Scale (X : Uint; R : Ratio) return Int is
 309       begin
 310          return UI_To_Int (X * R.Num / R.Den);
 311       end Scale;
 312
 313    begin
 314       pragma Assert (U.Rbase /= 0);
 315       return Scale (U.Den, Logs (U.Rbase));
 316    end Equivalent_Decimal_Exponent;
 317
 318    ----------------
 319    -- Initialize --
 320    ----------------
 321
 322    procedure Initialize is
 323    begin
 324       Ureals.Init;
 325       UR_0         := UR_From_Components (Uint_0, Uint_1,         0, False);
 326       UR_M_0       := UR_From_Components (Uint_0, Uint_1,         0, True);
 327       UR_Half      := UR_From_Components (Uint_1, Uint_1,         2, False);
 328       UR_Tenth     := UR_From_Components (Uint_1, Uint_1,        10, False);
 329       UR_1         := UR_From_Components (Uint_1, Uint_1,         0, False);
 330       UR_2         := UR_From_Components (Uint_1, Uint_Minus_1,   2, False);
 331       UR_10        := UR_From_Components (Uint_1, Uint_Minus_1,  10, False);
 332       UR_2_10_18   := UR_From_Components (Uint_2, Uint_Minus_18, 10, False);
 333       UR_9_10_36   := UR_From_Components (Uint_9, Uint_Minus_36, 10, False);
 334       UR_10_76     := UR_From_Components (Uint_1, Uint_Minus_76, 10, False);
 335       UR_M_2_10_18 := UR_From_Components (Uint_2, Uint_Minus_18, 10, True);
 336       UR_M_9_10_36 := UR_From_Components (Uint_9, Uint_Minus_36, 10, True);
 337       UR_M_10_76   := UR_From_Components (Uint_1, Uint_Minus_76, 10, True);
 338       UR_100       := UR_From_Components (Uint_1, Uint_Minus_2,  10, False);
 339       UR_2_127     := UR_From_Components (Uint_1, Uint_Minus_127, 2, False);
 340       UR_2_M_127   := UR_From_Components (Uint_1, Uint_127,       2, False);
 341       UR_2_128     := UR_From_Components (Uint_1, Uint_Minus_128, 2, False);
 342       UR_2_M_128   := UR_From_Components (Uint_1, Uint_128,       2, False);
 343       UR_2_31      := UR_From_Components (Uint_1, Uint_Minus_31,  2, False);
 344       UR_2_63      := UR_From_Components (Uint_1, Uint_Minus_63,  2, False);
 345       UR_2_80      := UR_From_Components (Uint_1, Uint_Minus_80,  2, False);
 346       UR_2_M_80    := UR_From_Components (Uint_1, Uint_80,        2, False);
 347    end Initialize;
 348
 349    ----------------
 350    -- Is_Integer --
 351    ----------------
 352
 353    function Is_Integer (Num, Den : Uint) return Boolean is
 354    begin
 355       return (Num / Den) * Den = Num;
 356    end Is_Integer;
 357
 358    ----------
 359    -- Mark --
 360    ----------
 361
 362    function Mark return Save_Mark is
 363    begin
 364       return Save_Mark (Ureals.Last);
 365    end Mark;
 366
 367    --------------
 368    -- Norm_Den --
 369    --------------
 370
 371    function Norm_Den (Real : Ureal) return Uint is
 372    begin
 373       if not Same (Real, Normalized_Real) then
 374          Normalized_Real  := Real;
 375          Normalized_Entry := Normalize (Ureals.Table (Real));
 376       end if;
 377
 378       return Normalized_Entry.Den;
 379    end Norm_Den;
 380
 381    --------------
 382    -- Norm_Num --
 383    --------------
 384
 385    function Norm_Num (Real : Ureal) return Uint is
 386    begin
 387       if not Same (Real, Normalized_Real) then
 388          Normalized_Real  := Real;
 389          Normalized_Entry := Normalize (Ureals.Table (Real));
 390       end if;
 391
 392       return Normalized_Entry.Num;
 393    end Norm_Num;
 394
 395    ---------------
 396    -- Normalize --
 397    ---------------
 398
 399    function Normalize (Val : Ureal_Entry) return Ureal_Entry is
 400       J   : Uint;
 401       K   : Uint;
 402       Tmp : Uint;
 403       Num : Uint;
 404       Den : Uint;
 405       M   : constant Uintp.Save_Mark := Mark;
 406
 407    begin
 408       --  Start by setting J to the greatest of the absolute values of the
 409       --  numerator and the denominator (taking into account the base value),
 410       --  and K to the lesser of the two absolute values. The gcd of Num and
 411       --  Den is the gcd of J and K.
 412
 413       if Val.Rbase = 0 then
 414          J := Val.Num;
 415          K := Val.Den;
 416
 417       elsif Val.Den < 0 then
 418          J := Val.Num * Val.Rbase ** (-Val.Den);
 419          K := Uint_1;
 420
 421       else
 422          J := Val.Num;
 423          K := Val.Rbase ** Val.Den;
 424       end if;
 425
 426       Num := J;
 427       Den := K;
 428
 429       if K > J then
 430          Tmp := J;
 431          J := K;
 432          K := Tmp;
 433       end if;
 434
 435       J := UI_GCD (J, K);
 436       Num := Num / J;
 437       Den := Den / J;
 438       Uintp.Release_And_Save (M, Num, Den);
 439
 440       --  Divide numerator and denominator by gcd and return result
 441
 442       return (Num      => Num,
 443               Den      => Den,
 444               Rbase    => 0,
 445               Negative => Val.Negative);
 446    end Normalize;
 447
 448    ---------------
 449    -- Numerator --
 450    ---------------
 451
 452    function Numerator (Real : Ureal) return Uint is
 453    begin
 454       return Ureals.Table (Real).Num;
 455    end Numerator;
 456
 457    --------
 458    -- pr --
 459    --------
 460
 461    procedure pr (Real : Ureal) is
 462    begin
 463       UR_Write (Real);
 464       Write_Eol;
 465    end pr;
 466
 467    -----------
 468    -- Rbase --
 469    -----------
 470
 471    function Rbase (Real : Ureal) return Nat is
 472    begin
 473       return Ureals.Table (Real).Rbase;
 474    end Rbase;
 475
 476    -------------
 477    -- Release --
 478    -------------
 479
 480    procedure Release (M : Save_Mark) is
 481    begin
 482       Ureals.Set_Last (Ureal (M));
 483    end Release;
 484
 485    ----------
 486    -- Same --
 487    ----------
 488
 489    function Same (U1, U2 : Ureal) return Boolean is
 490    begin
 491       return Int (U1) = Int (U2);
 492    end Same;
 493
 494    -----------------
 495    -- Store_Ureal --
 496    -----------------
 497
 498    function Store_Ureal (Val : Ureal_Entry) return Ureal is
 499    begin
 500       Ureals.Append (Val);
 501
 502       --  Normalize representation of signed values
 503
 504       if Val.Num < 0 then
 505          Ureals.Table (Ureals.Last).Negative := True;
 506          Ureals.Table (Ureals.Last).Num := -Val.Num;
 507       end if;
 508
 509       return Ureals.Last;
 510    end Store_Ureal;
 511
 512    ----------------------------
 513    -- Store_Ureal_Normalized --
 514    ----------------------------
 515
 516    function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is
 517    begin
 518       return Store_Ureal (Normalize (Val));
 519    end Store_Ureal_Normalized;
 520
 521    ------------
 522    -- UR_Abs --
 523    ------------
 524
 525    function UR_Abs (Real : Ureal) return Ureal is
 526       Val : constant Ureal_Entry := Ureals.Table (Real);
 527
 528    begin
 529       return Store_Ureal
 530                ((Num      => Val.Num,
 531                  Den      => Val.Den,
 532                  Rbase    => Val.Rbase,
 533                  Negative => False));
 534    end UR_Abs;
 535
 536    ------------
 537    -- UR_Add --
 538    ------------
 539
 540    function UR_Add (Left : Uint; Right : Ureal) return Ureal is
 541    begin
 542       return UR_From_Uint (Left) + Right;
 543    end UR_Add;
 544
 545    function UR_Add (Left : Ureal; Right : Uint) return Ureal is
 546    begin
 547       return Left + UR_From_Uint (Right);
 548    end UR_Add;
 549
 550    function UR_Add (Left : Ureal; Right : Ureal) return Ureal is
 551       Lval : Ureal_Entry := Ureals.Table (Left);
 552       Rval : Ureal_Entry := Ureals.Table (Right);
 553       Num  : Uint;
 554
 555    begin
 556       pragma Annotate (CodePeer, Modified, Lval);
 557       pragma Annotate (CodePeer, Modified, Rval);
 558
 559       --  Note, in the temporary Ureal_Entry values used in this procedure,
 560       --  we store the sign as the sign of the numerator (i.e. xxx.Num may
 561       --  be negative, even though in stored entries this can never be so)
 562
 563       if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then
 564          declare
 565             Opd_Min, Opd_Max   : Ureal_Entry;
 566             Exp_Min, Exp_Max   : Uint;
 567
 568          begin
 569             if Lval.Negative then
 570                Lval.Num := (-Lval.Num);
 571             end if;
 572
 573             if Rval.Negative then
 574                Rval.Num := (-Rval.Num);
 575             end if;
 576
 577             if Lval.Den < Rval.Den then
 578                Exp_Min := Lval.Den;
 579                Exp_Max := Rval.Den;
 580                Opd_Min := Lval;
 581                Opd_Max := Rval;
 582             else
 583                Exp_Min := Rval.Den;
 584                Exp_Max := Lval.Den;
 585                Opd_Min := Rval;
 586                Opd_Max := Lval;
 587             end if;
 588
 589             Num :=
 590               Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num;
 591
 592             if Num = 0 then
 593                return Store_Ureal
 594                         ((Num      => Uint_0,
 595                           Den      => Uint_1,
 596                           Rbase    => 0,
 597                           Negative => Lval.Negative));
 598
 599             else
 600                return Store_Ureal
 601                         ((Num      => abs Num,
 602                           Den      => Exp_Max,
 603                           Rbase    => Lval.Rbase,
 604                           Negative => (Num < 0)));
 605             end if;
 606          end;
 607
 608       else
 609          declare
 610             Ln : Ureal_Entry := Normalize (Lval);
 611             Rn : Ureal_Entry := Normalize (Rval);
 612
 613          begin
 614             if Ln.Negative then
 615                Ln.Num := (-Ln.Num);
 616             end if;
 617
 618             if Rn.Negative then
 619                Rn.Num := (-Rn.Num);
 620             end if;
 621
 622             Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den);
 623
 624             if Num = 0 then
 625                return Store_Ureal
 626                         ((Num      => Uint_0,
 627                           Den      => Uint_1,
 628                           Rbase    => 0,
 629                           Negative => Lval.Negative));
 630
 631             else
 632                return Store_Ureal_Normalized
 633                         ((Num      => abs Num,
 634                           Den      => Ln.Den * Rn.Den,
 635                           Rbase    => 0,
 636                           Negative => (Num < 0)));
 637             end if;
 638          end;
 639       end if;
 640    end UR_Add;
 641
 642    ----------------
 643    -- UR_Ceiling --
 644    ----------------
 645
 646    function UR_Ceiling (Real : Ureal) return Uint is
 647       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
 648    begin
 649       if Val.Negative then
 650          return UI_Negate (Val.Num / Val.Den);
 651       else
 652          return (Val.Num + Val.Den - 1) / Val.Den;
 653       end if;
 654    end UR_Ceiling;
 655
 656    ------------
 657    -- UR_Div --
 658    ------------
 659
 660    function UR_Div (Left : Uint; Right : Ureal) return Ureal is
 661    begin
 662       return UR_From_Uint (Left) / Right;
 663    end UR_Div;
 664
 665    function UR_Div (Left : Ureal; Right : Uint) return Ureal is
 666    begin
 667       return Left / UR_From_Uint (Right);
 668    end UR_Div;
 669
 670    function UR_Div (Left, Right : Ureal) return Ureal is
 671       Lval : constant Ureal_Entry := Ureals.Table (Left);
 672       Rval : constant Ureal_Entry := Ureals.Table (Right);
 673       Rneg : constant Boolean     := Rval.Negative xor Lval.Negative;
 674
 675    begin
 676       pragma Annotate (CodePeer, Modified, Lval);
 677       pragma Annotate (CodePeer, Modified, Rval);
 678       pragma Assert (Rval.Num /= Uint_0);
 679
 680       if Lval.Rbase = 0 then
 681          if Rval.Rbase = 0 then
 682             return Store_Ureal_Normalized
 683                      ((Num      => Lval.Num * Rval.Den,
 684                        Den      => Lval.Den * Rval.Num,
 685                        Rbase    => 0,
 686                        Negative => Rneg));
 687
 688          elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then
 689             return Store_Ureal
 690                      ((Num      => Lval.Num / (Rval.Num * Lval.Den),
 691                        Den      => (-Rval.Den),
 692                        Rbase    => Rval.Rbase,
 693                        Negative => Rneg));
 694
 695          elsif Rval.Den < 0 then
 696             return Store_Ureal_Normalized
 697                      ((Num      => Lval.Num,
 698                        Den      => Rval.Rbase ** (-Rval.Den) *
 699                                    Rval.Num *
 700                                    Lval.Den,
 701                        Rbase    => 0,
 702                        Negative => Rneg));
 703
 704          else
 705             return Store_Ureal_Normalized
 706                      ((Num      => Lval.Num * Rval.Rbase ** Rval.Den,
 707                        Den      => Rval.Num * Lval.Den,
 708                        Rbase    => 0,
 709                        Negative => Rneg));
 710          end if;
 711
 712       elsif Is_Integer (Lval.Num, Rval.Num) then
 713          if Rval.Rbase = Lval.Rbase then
 714             return Store_Ureal
 715                      ((Num      => Lval.Num / Rval.Num,
 716                        Den      => Lval.Den - Rval.Den,
 717                        Rbase    => Lval.Rbase,
 718                        Negative => Rneg));
 719
 720          elsif Rval.Rbase = 0 then
 721             return Store_Ureal
 722                      ((Num      => (Lval.Num / Rval.Num) * Rval.Den,
 723                        Den      => Lval.Den,
 724                        Rbase    => Lval.Rbase,
 725                        Negative => Rneg));
 726
 727          elsif Rval.Den < 0 then
 728             declare
 729                Num, Den : Uint;
 730
 731             begin
 732                if Lval.Den < 0 then
 733                   Num := (Lval.Num / Rval.Num) * (Lval.Rbase ** (-Lval.Den));
 734                   Den := Rval.Rbase ** (-Rval.Den);
 735                else
 736                   Num := Lval.Num / Rval.Num;
 737                   Den := (Lval.Rbase ** Lval.Den) *
 738                          (Rval.Rbase ** (-Rval.Den));
 739                end if;
 740
 741                return Store_Ureal
 742                         ((Num      => Num,
 743                           Den      => Den,
 744                           Rbase    => 0,
 745                           Negative => Rneg));
 746             end;
 747
 748          else
 749             return Store_Ureal
 750                      ((Num      => (Lval.Num / Rval.Num) *
 751                                    (Rval.Rbase ** Rval.Den),
 752                        Den      => Lval.Den,
 753                        Rbase    => Lval.Rbase,
 754                        Negative => Rneg));
 755          end if;
 756
 757       else
 758          declare
 759             Num, Den : Uint;
 760
 761          begin
 762             if Lval.Den < 0 then
 763                Num := Lval.Num * (Lval.Rbase ** (-Lval.Den));
 764                Den := Rval.Num;
 765             else
 766                Num := Lval.Num;
 767                Den := Rval.Num * (Lval.Rbase ** Lval.Den);
 768             end if;
 769
 770             if Rval.Rbase /= 0 then
 771                if Rval.Den < 0 then
 772                   Den := Den * (Rval.Rbase ** (-Rval.Den));
 773                else
 774                   Num := Num * (Rval.Rbase ** Rval.Den);
 775                end if;
 776
 777             else
 778                Num := Num * Rval.Den;
 779             end if;
 780
 781             return Store_Ureal_Normalized
 782                      ((Num      => Num,
 783                        Den      => Den,
 784                        Rbase    => 0,
 785                        Negative => Rneg));
 786          end;
 787       end if;
 788    end UR_Div;
 789
 790    -----------
 791    -- UR_Eq --
 792    -----------
 793
 794    function UR_Eq (Left, Right : Ureal) return Boolean is
 795    begin
 796       return not UR_Ne (Left, Right);
 797    end UR_Eq;
 798
 799    ---------------------
 800    -- UR_Exponentiate --
 801    ---------------------
 802
 803    function UR_Exponentiate (Real : Ureal; N : Uint) return Ureal is
 804       X    : constant Uint := abs N;
 805       Bas  : Ureal;
 806       Val  : Ureal_Entry;
 807       Neg  : Boolean;
 808       IBas : Uint;
 809
 810    begin
 811       --  If base is negative, then the resulting sign depends on whether
 812       --  the exponent is even or odd (even => positive, odd = negative)
 813
 814       if UR_Is_Negative (Real) then
 815          Neg := (N mod 2) /= 0;
 816          Bas := UR_Negate (Real);
 817       else
 818          Neg := False;
 819          Bas := Real;
 820       end if;
 821
 822       Val := Ureals.Table (Bas);
 823
 824       --  If the base is a small integer, then we can return the result in
 825       --  exponential form, which can save a lot of time for junk exponents.
 826
 827       IBas := UR_Trunc (Bas);
 828
 829       if IBas <= 16
 830         and then UR_From_Uint (IBas) = Bas
 831       then
 832          return Store_Ureal
 833                   ((Num      => Uint_1,
 834                     Den      => -N,
 835                     Rbase    => UI_To_Int (UR_Trunc (Bas)),
 836                     Negative => Neg));
 837
 838       --  If the exponent is negative then we raise the numerator and the
 839       --  denominator (after normalization) to the absolute value of the
 840       --  exponent and we return the reciprocal. An assert error will happen
 841       --  if the numerator is zero.
 842
 843       elsif N < 0 then
 844          pragma Assert (Val.Num /= 0);
 845          Val := Normalize (Val);
 846
 847          return Store_Ureal
 848                   ((Num      => Val.Den ** X,
 849                     Den      => Val.Num ** X,
 850                     Rbase    => 0,
 851                     Negative => Neg));
 852
 853       --  If positive, we distinguish the case when the base is not zero, in
 854       --  which case the new denominator is just the product of the old one
 855       --  with the exponent,
 856
 857       else
 858          if Val.Rbase /= 0 then
 859
 860             return Store_Ureal
 861                      ((Num      => Val.Num ** X,
 862                        Den      => Val.Den * X,
 863                        Rbase    => Val.Rbase,
 864                        Negative => Neg));
 865
 866          --  And when the base is zero, in which case we exponentiate
 867          --  the old denominator.
 868
 869          else
 870             return Store_Ureal
 871                      ((Num      => Val.Num ** X,
 872                        Den      => Val.Den ** X,
 873                        Rbase    => 0,
 874                        Negative => Neg));
 875          end if;
 876       end if;
 877    end UR_Exponentiate;
 878
 879    --------------
 880    -- UR_Floor --
 881    --------------
 882
 883    function UR_Floor (Real : Ureal) return Uint is
 884       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
 885    begin
 886       if Val.Negative then
 887          return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den);
 888       else
 889          return Val.Num / Val.Den;
 890       end if;
 891    end UR_Floor;
 892
 893    ------------------------
 894    -- UR_From_Components --
 895    ------------------------
 896
 897    function UR_From_Components
 898      (Num      : Uint;
 899       Den      : Uint;
 900       Rbase    : Nat := 0;
 901       Negative : Boolean := False)
 902       return     Ureal
 903    is
 904    begin
 905       return Store_Ureal
 906                ((Num      => Num,
 907                  Den      => Den,
 908                  Rbase    => Rbase,
 909                  Negative => Negative));
 910    end UR_From_Components;
 911
 912    ------------------
 913    -- UR_From_Uint --
 914    ------------------
 915
 916    function UR_From_Uint (UI : Uint) return Ureal is
 917    begin
 918       return UR_From_Components
 919                (abs UI, Uint_1, Negative => (UI < 0));
 920    end UR_From_Uint;
 921
 922    -----------
 923    -- UR_Ge --
 924    -----------
 925
 926    function UR_Ge (Left, Right : Ureal) return Boolean is
 927    begin
 928       return not (Left < Right);
 929    end UR_Ge;
 930
 931    -----------
 932    -- UR_Gt --
 933    -----------
 934
 935    function UR_Gt (Left, Right : Ureal) return Boolean is
 936    begin
 937       return (Right < Left);
 938    end UR_Gt;
 939
 940    --------------------
 941    -- UR_Is_Negative --
 942    --------------------
 943
 944    function UR_Is_Negative (Real : Ureal) return Boolean is
 945    begin
 946       return Ureals.Table (Real).Negative;
 947    end UR_Is_Negative;
 948
 949    --------------------
 950    -- UR_Is_Positive --
 951    --------------------
 952
 953    function UR_Is_Positive (Real : Ureal) return Boolean is
 954    begin
 955       return not Ureals.Table (Real).Negative
 956         and then Ureals.Table (Real).Num /= 0;
 957    end UR_Is_Positive;
 958
 959    ----------------
 960    -- UR_Is_Zero --
 961    ----------------
 962
 963    function UR_Is_Zero (Real : Ureal) return Boolean is
 964    begin
 965       return Ureals.Table (Real).Num = 0;
 966    end UR_Is_Zero;
 967
 968    -----------
 969    -- UR_Le --
 970    -----------
 971
 972    function UR_Le (Left, Right : Ureal) return Boolean is
 973    begin
 974       return not (Right < Left);
 975    end UR_Le;
 976
 977    -----------
 978    -- UR_Lt --
 979    -----------
 980
 981    function UR_Lt (Left, Right : Ureal) return Boolean is
 982    begin
 983       --  An operand is not less than itself
 984
 985       if Same (Left, Right) then
 986          return False;
 987
 988       --  Deal with zero cases
 989
 990       elsif UR_Is_Zero (Left) then
 991          return UR_Is_Positive (Right);
 992
 993       elsif UR_Is_Zero (Right) then
 994          return Ureals.Table (Left).Negative;
 995
 996       --  Different signs are decisive (note we dealt with zero cases)
 997
 998       elsif Ureals.Table (Left).Negative
 999         and then not Ureals.Table (Right).Negative
1000       then
1001          return True;
1002
1003       elsif not Ureals.Table (Left).Negative
1004         and then Ureals.Table (Right).Negative
1005       then
1006          return False;
1007
1008       --  Signs are same, do rapid check based on worst case estimates of
1009       --  decimal exponent, which will often be decisive. Precise test
1010       --  depends on whether operands are positive or negative.
1011
1012       elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) then
1013          return UR_Is_Positive (Left);
1014
1015       elsif Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right) then
1016          return UR_Is_Negative (Left);
1017
1018       --  If we fall through, full gruesome test is required. This happens
1019       --  if the numbers are close together, or in some weird (/=10) base.
1020
1021       else
1022          declare
1023             Imrk   : constant Uintp.Save_Mark  := Mark;
1024             Rmrk   : constant Urealp.Save_Mark := Mark;
1025             Lval   : Ureal_Entry;
1026             Rval   : Ureal_Entry;
1027             Result : Boolean;
1028
1029          begin
1030             Lval := Ureals.Table (Left);
1031             Rval := Ureals.Table (Right);
1032
1033             --  An optimization. If both numbers are based, then subtract
1034             --  common value of base to avoid unnecessarily giant numbers
1035
1036             if Lval.Rbase = Rval.Rbase and then Lval.Rbase /= 0 then
1037                if Lval.Den < Rval.Den then
1038                   Rval.Den := Rval.Den - Lval.Den;
1039                   Lval.Den := Uint_0;
1040                else
1041                   Lval.Den := Lval.Den - Rval.Den;
1042                   Rval.Den := Uint_0;
1043                end if;
1044             end if;
1045
1046             Lval := Normalize (Lval);
1047             Rval := Normalize (Rval);
1048
1049             if Lval.Negative then
1050                Result := (Lval.Num * Rval.Den) > (Rval.Num * Lval.Den);
1051             else
1052                Result := (Lval.Num * Rval.Den) < (Rval.Num * Lval.Den);
1053             end if;
1054
1055             Release (Imrk);
1056             Release (Rmrk);
1057             return Result;
1058          end;
1059       end if;
1060    end UR_Lt;
1061
1062    ------------
1063    -- UR_Max --
1064    ------------
1065
1066    function UR_Max (Left, Right : Ureal) return Ureal is
1067    begin
1068       if Left >= Right then
1069          return Left;
1070       else
1071          return Right;
1072       end if;
1073    end UR_Max;
1074
1075    ------------
1076    -- UR_Min --
1077    ------------
1078
1079    function UR_Min (Left, Right : Ureal) return Ureal is
1080    begin
1081       if Left <= Right then
1082          return Left;
1083       else
1084          return Right;
1085       end if;
1086    end UR_Min;
1087
1088    ------------
1089    -- UR_Mul --
1090    ------------
1091
1092    function UR_Mul (Left : Uint; Right : Ureal) return Ureal is
1093    begin
1094       return UR_From_Uint (Left) * Right;
1095    end UR_Mul;
1096
1097    function UR_Mul (Left : Ureal; Right : Uint) return Ureal is
1098    begin
1099       return Left * UR_From_Uint (Right);
1100    end UR_Mul;
1101
1102    function UR_Mul (Left, Right : Ureal) return Ureal is
1103       Lval : constant Ureal_Entry := Ureals.Table (Left);
1104       Rval : constant Ureal_Entry := Ureals.Table (Right);
1105       Num  : Uint                 := Lval.Num * Rval.Num;
1106       Den  : Uint;
1107       Rneg : constant Boolean     := Lval.Negative xor Rval.Negative;
1108
1109    begin
1110       if Lval.Rbase = 0 then
1111          if Rval.Rbase = 0 then
1112             return Store_Ureal_Normalized
1113                      ((Num      => Num,
1114                        Den      => Lval.Den * Rval.Den,
1115                        Rbase    => 0,
1116                        Negative => Rneg));
1117
1118          elsif Is_Integer (Num, Lval.Den) then
1119             return Store_Ureal
1120                      ((Num      => Num / Lval.Den,
1121                        Den      => Rval.Den,
1122                        Rbase    => Rval.Rbase,
1123                        Negative => Rneg));
1124
1125          elsif Rval.Den < 0 then
1126             return Store_Ureal_Normalized
1127                      ((Num      => Num * (Rval.Rbase ** (-Rval.Den)),
1128                        Den      => Lval.Den,
1129                        Rbase    => 0,
1130                        Negative => Rneg));
1131
1132          else
1133             return Store_Ureal_Normalized
1134                      ((Num      => Num,
1135                        Den      => Lval.Den * (Rval.Rbase ** Rval.Den),
1136                        Rbase    => 0,
1137                        Negative => Rneg));
1138          end if;
1139
1140       elsif Lval.Rbase = Rval.Rbase then
1141          return Store_Ureal
1142                   ((Num      => Num,
1143                     Den      => Lval.Den + Rval.Den,
1144                     Rbase    => Lval.Rbase,
1145                     Negative => Rneg));
1146
1147       elsif Rval.Rbase = 0 then
1148          if Is_Integer (Num, Rval.Den) then
1149             return Store_Ureal
1150                      ((Num      => Num / Rval.Den,
1151                        Den      => Lval.Den,
1152                        Rbase    => Lval.Rbase,
1153                        Negative => Rneg));
1154
1155          elsif Lval.Den < 0 then
1156             return Store_Ureal_Normalized
1157                      ((Num      => Num * (Lval.Rbase ** (-Lval.Den)),
1158                        Den      => Rval.Den,
1159                        Rbase    => 0,
1160                        Negative => Rneg));
1161
1162          else
1163             return Store_Ureal_Normalized
1164                      ((Num      => Num,
1165                        Den      => Rval.Den * (Lval.Rbase ** Lval.Den),
1166                        Rbase    => 0,
1167                        Negative => Rneg));
1168          end if;
1169
1170       else
1171          Den := Uint_1;
1172
1173          if Lval.Den < 0 then
1174             Num := Num * (Lval.Rbase ** (-Lval.Den));
1175          else
1176             Den := Den * (Lval.Rbase ** Lval.Den);
1177          end if;
1178
1179          if Rval.Den < 0 then
1180             Num := Num * (Rval.Rbase ** (-Rval.Den));
1181          else
1182             Den := Den * (Rval.Rbase ** Rval.Den);
1183          end if;
1184
1185          return Store_Ureal_Normalized
1186                   ((Num      => Num,
1187                     Den      => Den,
1188                     Rbase    => 0,
1189                     Negative => Rneg));
1190       end if;
1191    end UR_Mul;
1192
1193    -----------
1194    -- UR_Ne --
1195    -----------
1196
1197    function UR_Ne (Left, Right : Ureal) return Boolean is
1198    begin
1199       --  Quick processing for case of identical Ureal values (note that
1200       --  this also deals with comparing two No_Ureal values).
1201
1202       if Same (Left, Right) then
1203          return False;
1204
1205       --  Deal with case of one or other operand is No_Ureal, but not both
1206
1207       elsif Same (Left, No_Ureal) or else Same (Right, No_Ureal) then
1208          return True;
1209
1210       --  Do quick check based on number of decimal digits
1211
1212       elsif Decimal_Exponent_Hi (Left) < Decimal_Exponent_Lo (Right) or else
1213             Decimal_Exponent_Lo (Left) > Decimal_Exponent_Hi (Right)
1214       then
1215          return True;
1216
1217       --  Otherwise full comparison is required
1218
1219       else
1220          declare
1221             Imrk   : constant Uintp.Save_Mark  := Mark;
1222             Rmrk   : constant Urealp.Save_Mark := Mark;
1223             Lval   : constant Ureal_Entry := Normalize (Ureals.Table (Left));
1224             Rval   : constant Ureal_Entry := Normalize (Ureals.Table (Right));
1225             Result : Boolean;
1226
1227          begin
1228             if UR_Is_Zero (Left) then
1229                return not UR_Is_Zero (Right);
1230
1231             elsif UR_Is_Zero (Right) then
1232                return not UR_Is_Zero (Left);
1233
1234             --  Both operands are non-zero
1235
1236             else
1237                Result :=
1238                   Rval.Negative /= Lval.Negative
1239                     or else Rval.Num /= Lval.Num
1240                     or else Rval.Den /= Lval.Den;
1241                Release (Imrk);
1242                Release (Rmrk);
1243                return Result;
1244             end if;
1245          end;
1246       end if;
1247    end UR_Ne;
1248
1249    ---------------
1250    -- UR_Negate --
1251    ---------------
1252
1253    function UR_Negate (Real : Ureal) return Ureal is
1254    begin
1255       return Store_Ureal
1256                ((Num      => Ureals.Table (Real).Num,
1257                  Den      => Ureals.Table (Real).Den,
1258                  Rbase    => Ureals.Table (Real).Rbase,
1259                  Negative => not Ureals.Table (Real).Negative));
1260    end UR_Negate;
1261
1262    ------------
1263    -- UR_Sub --
1264    ------------
1265
1266    function UR_Sub (Left : Uint; Right : Ureal) return Ureal is
1267    begin
1268       return UR_From_Uint (Left) + UR_Negate (Right);
1269    end UR_Sub;
1270
1271    function UR_Sub (Left : Ureal; Right : Uint) return Ureal is
1272    begin
1273       return Left + UR_From_Uint (-Right);
1274    end UR_Sub;
1275
1276    function UR_Sub (Left, Right : Ureal) return Ureal is
1277    begin
1278       return Left + UR_Negate (Right);
1279    end UR_Sub;
1280
1281    ----------------
1282    -- UR_To_Uint --
1283    ----------------
1284
1285    function UR_To_Uint (Real : Ureal) return Uint is
1286       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1287       Res : Uint;
1288
1289    begin
1290       Res := (Val.Num + (Val.Den / 2)) / Val.Den;
1291
1292       if Val.Negative then
1293          return UI_Negate (Res);
1294       else
1295          return Res;
1296       end if;
1297    end UR_To_Uint;
1298
1299    --------------
1300    -- UR_Trunc --
1301    --------------
1302
1303    function UR_Trunc (Real : Ureal) return Uint is
1304       Val : constant Ureal_Entry := Normalize (Ureals.Table (Real));
1305    begin
1306       if Val.Negative then
1307          return -(Val.Num / Val.Den);
1308       else
1309          return Val.Num / Val.Den;
1310       end if;
1311    end UR_Trunc;
1312
1313    --------------
1314    -- UR_Write --
1315    --------------
1316
1317    procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is
1318       Val : constant Ureal_Entry := Ureals.Table (Real);
1319       T   : Uint;
1320
1321    begin
1322       --  If value is negative, we precede the constant by a minus sign
1323
1324       if Val.Negative then
1325          Write_Char ('-');
1326       end if;
1327
1328       --  Zero is zero
1329
1330       if Val.Num = 0 then
1331          Write_Str ("0.0");
1332
1333       --  For constants with a denominator of zero, the value is simply the
1334       --  numerator value, since we are dividing by base**0, which is 1.
1335
1336       elsif Val.Den = 0 then
1337          UI_Write (Val.Num, Decimal);
1338          Write_Str (".0");
1339
1340       --  Small powers of 2 get written in decimal fixed-point format
1341
1342       elsif Val.Rbase = 2
1343         and then Val.Den <= 3
1344         and then Val.Den >= -16
1345       then
1346          if Val.Den = 1 then
1347             T := Val.Num * (10 / 2);
1348             UI_Write (T / 10, Decimal);
1349             Write_Char ('.');
1350             UI_Write (T mod 10, Decimal);
1351
1352          elsif Val.Den = 2 then
1353             T := Val.Num * (100 / 4);
1354             UI_Write (T / 100, Decimal);
1355             Write_Char ('.');
1356             UI_Write (T mod 100 / 10, Decimal);
1357
1358             if T mod 10 /= 0 then
1359                UI_Write (T mod 10, Decimal);
1360             end if;
1361
1362          elsif Val.Den = 3 then
1363             T := Val.Num * (1000 / 8);
1364             UI_Write (T / 1000, Decimal);
1365             Write_Char ('.');
1366             UI_Write (T mod 1000 / 100, Decimal);
1367
1368             if T mod 100 /= 0 then
1369                UI_Write (T mod 100 / 10, Decimal);
1370
1371                if T mod 10 /= 0 then
1372                   UI_Write (T mod 10, Decimal);
1373                end if;
1374             end if;
1375
1376          else
1377             UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal);
1378             Write_Str (".0");
1379          end if;
1380
1381       --  Constants in base 10 or 16 can be written in normal Ada literal
1382       --  style, as long as they fit in the UI_Image_Buffer. Using hexadecimal
1383       --  notation, 4 bytes are required for the 16# # part, and every fifth
1384       --  character is an underscore. So, a buffer of size N has room for
1385       --     ((N - 4) - (N - 4) / 5) * 4 bits,
1386       --  or at least
1387       --     N * 16 / 5 - 12 bits.
1388
1389       elsif (Val.Rbase = 10 or else Val.Rbase = 16)
1390         and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12
1391       then
1392          pragma Assert (Val.Den /= 0);
1393
1394          --  Use fixed-point format for small scaling values
1395
1396          if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3)
1397               or else (Val.Rbase = 16 and then Val.Den = -1)
1398          then
1399             UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal);
1400             Write_Str (".0");
1401
1402          --  Write hexadecimal constants in exponential notation with a zero
1403          --  unit digit. This matches the Ada canonical form for floating point
1404          --  numbers, and also ensures that the underscores end up in the
1405          --  correct place.
1406
1407          elsif Val.Rbase = 16 then
1408             UI_Image (Val.Num, Hex);
1409             pragma Assert (Val.Rbase = 16);
1410
1411             Write_Str ("16#0.");
1412             Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
1413
1414             --  For exponent, exclude 16# # and underscores from length
1415
1416             UI_Image_Length := UI_Image_Length - 4;
1417             UI_Image_Length := UI_Image_Length - UI_Image_Length / 5;
1418
1419             Write_Char ('E');
1420             UI_Write (Int (UI_Image_Length) - Val.Den, Decimal);
1421
1422          elsif Val.Den = 1 then
1423             UI_Write (Val.Num / 10, Decimal);
1424             Write_Char ('.');
1425             UI_Write (Val.Num mod 10, Decimal);
1426
1427          elsif Val.Den = 2 then
1428             UI_Write (Val.Num / 100, Decimal);
1429             Write_Char ('.');
1430             UI_Write (Val.Num / 10 mod 10, Decimal);
1431             UI_Write (Val.Num mod 10, Decimal);
1432
1433          --  Else use decimal exponential format
1434
1435          else
1436             --  Write decimal constants with a non-zero unit digit. This
1437             --  matches usual scientific notation.
1438
1439             UI_Image (Val.Num, Decimal);
1440             Write_Char (UI_Image_Buffer (1));
1441             Write_Char ('.');
1442
1443             if UI_Image_Length = 1 then
1444                Write_Char ('0');
1445             else
1446                Write_Str (UI_Image_Buffer (2 .. UI_Image_Length));
1447             end if;
1448
1449             Write_Char ('E');
1450             UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal);
1451          end if;
1452
1453       --  Other constants with a base other than 10 are written using one of
1454       --  the following forms, depending on the sign of the number and the
1455       --  sign of the exponent (= minus denominator value). See that we are
1456       --  replacing the division by a multiplication (updating accordingly the
1457       --  sign of the exponent) to generate an expression whose computation
1458       --  does not cause a division by 0 when base**exponent is very small.
1459
1460       --    numerator.0*base**exponent
1461       --    numerator.0*base**-exponent
1462
1463       --  And of course an exponent of 0 can be omitted.
1464
1465       elsif Val.Rbase /= 0 then
1466          if Brackets then
1467             Write_Char ('[');
1468          end if;
1469
1470          UI_Write (Val.Num, Decimal);
1471          Write_Str (".0");
1472
1473          if Val.Den /= 0 then
1474             Write_Char ('*');
1475             Write_Int (Val.Rbase);
1476             Write_Str ("**");
1477
1478             if Val.Den <= 0 then
1479                UI_Write (-Val.Den, Decimal);
1480             else
1481                Write_Str ("(-");
1482                UI_Write (Val.Den, Decimal);
1483                Write_Char (')');
1484             end if;
1485          end if;
1486
1487          if Brackets then
1488             Write_Char (']');
1489          end if;
1490
1491       --  Rationals where numerator is divisible by denominator can be output
1492       --  as literals after we do the division. This includes the common case
1493       --  where the denominator is 1.
1494
1495       elsif Val.Num mod Val.Den = 0 then
1496          UI_Write (Val.Num / Val.Den, Decimal);
1497          Write_Str (".0");
1498
1499       --  Other non-based (rational) constants are written in num/den style
1500
1501       else
1502          if Brackets then
1503             Write_Char ('[');
1504          end if;
1505
1506          UI_Write (Val.Num, Decimal);
1507          Write_Str (".0/");
1508          UI_Write (Val.Den, Decimal);
1509          Write_Str (".0");
1510
1511          if Brackets then
1512             Write_Char (']');
1513          end if;
1514       end if;
1515    end UR_Write;
1516
1517    ----------------------
1518    -- UR_Write_To_JSON --
1519    ----------------------
1520
1521    --  We defer to the implementation of UR_Write for values that are naturally
1522    --  written in a JSON compatible format and write a fraction for the others.
1523
1524    procedure UR_Write_To_JSON (Real : Ureal) is
1525       Val : constant Ureal_Entry := Ureals.Table (Real);
1526
1527       T : Ureal;
1528
1529    begin
1530       --  Zero is zero
1531
1532       if Val.Num = 0 then
1533          T := Real;
1534
1535       --  For constants with a denominator of zero, the value is simply the
1536       --  numerator value, since we are dividing by base**0, which is 1.
1537
1538       elsif Val.Den = 0 then
1539          T := Real;
1540
1541       --  Small powers of 2 get written in decimal fixed-point format
1542
1543       elsif Val.Rbase = 2
1544         and then Val.Den <= 3
1545         and then Val.Den >= -16
1546       then
1547          T := Real;
1548
1549       --  Constants in base 10 can be written in normal Ada literal style
1550
1551       elsif Val.Rbase = 10 then
1552          T := Real;
1553
1554       --  Rationals where numerator is divisible by denominator can be output
1555       --  as literals after we do the division. This includes the common case
1556       --  where the denominator is 1.
1557
1558       elsif Val.Rbase = 0 and then Val.Num mod Val.Den = 0 then
1559          T := Real;
1560
1561       --  Other non-based (rational) constants are written in num/den style
1562
1563       else
1564          Write_Str ("{ ""code"": ""/"", ""operands"": [ ");
1565          if Val.Negative then
1566             Write_Char ('-');
1567          end if;
1568          UI_Write (Val.Num, Decimal);
1569          Write_Str (".0, ");
1570          UI_Write (Val.Den, Decimal);
1571          Write_Str (".0 ] }");
1572          return;
1573       end if;
1574
1575       UR_Write (T);
1576    end UR_Write_To_JSON;
1577
1578    -------------
1579    -- Ureal_0 --
1580    -------------
1581
1582    function Ureal_0 return Ureal is
1583    begin
1584       return UR_0;
1585    end Ureal_0;
1586
1587    -------------
1588    -- Ureal_1 --
1589    -------------
1590
1591    function Ureal_1 return Ureal is
1592    begin
1593       return UR_1;
1594    end Ureal_1;
1595
1596    -------------
1597    -- Ureal_2 --
1598    -------------
1599
1600    function Ureal_2 return Ureal is
1601    begin
1602       return UR_2;
1603    end Ureal_2;
1604
1605    --------------
1606    -- Ureal_10 --
1607    --------------
1608
1609    function Ureal_10 return Ureal is
1610    begin
1611       return UR_10;
1612    end Ureal_10;
1613
1614    ---------------
1615    -- Ureal_100 --
1616    ---------------
1617
1618    function Ureal_100 return Ureal is
1619    begin
1620       return UR_100;
1621    end Ureal_100;
1622
1623    -------------------
1624    -- Ureal_2_10_18 --
1625    -------------------
1626
1627    function Ureal_2_10_18 return Ureal is
1628    begin
1629       return UR_2_10_18;
1630    end Ureal_2_10_18;
1631
1632    -------------------
1633    -- Ureal_9_10_36 --
1634    -------------------
1635
1636    function Ureal_9_10_36 return Ureal is
1637    begin
1638       return UR_9_10_36;
1639    end Ureal_9_10_36;
1640
1641    -----------------
1642    -- Ureal_10_76 --
1643    -----------------
1644
1645    function Ureal_10_76 return Ureal is
1646    begin
1647       return UR_10_76;
1648    end Ureal_10_76;
1649
1650    ----------------
1651    -- Ureal_2_31 --
1652    ----------------
1653
1654    function Ureal_2_31 return Ureal is
1655    begin
1656       return UR_2_31;
1657    end Ureal_2_31;
1658
1659    ----------------
1660    -- Ureal_2_63 --
1661    ----------------
1662
1663    function Ureal_2_63 return Ureal is
1664    begin
1665       return UR_2_63;
1666    end Ureal_2_63;
1667
1668    ----------------
1669    -- Ureal_2_80 --
1670    ----------------
1671
1672    function Ureal_2_80 return Ureal is
1673    begin
1674       return UR_2_80;
1675    end Ureal_2_80;
1676
1677    -----------------
1678    -- Ureal_2_127 --
1679    -----------------
1680
1681    function Ureal_2_127 return Ureal is
1682    begin
1683       return UR_2_127;
1684    end Ureal_2_127;
1685
1686    -----------------
1687    -- Ureal_2_128 --
1688    -----------------
1689
1690    function Ureal_2_128 return Ureal is
1691    begin
1692       return UR_2_128;
1693    end Ureal_2_128;
1694
1695    -------------------
1696    -- Ureal_2_M_80 --
1697    -------------------
1698
1699    function Ureal_2_M_80 return Ureal is
1700    begin
1701       return UR_2_M_80;
1702    end Ureal_2_M_80;
1703
1704    -------------------
1705    -- Ureal_2_M_127 --
1706    -------------------
1707
1708    function Ureal_2_M_127 return Ureal is
1709    begin
1710       return UR_2_M_127;
1711    end Ureal_2_M_127;
1712
1713    -------------------
1714    -- Ureal_2_M_128 --
1715    -------------------
1716
1717    function Ureal_2_M_128 return Ureal is
1718    begin
1719       return UR_2_M_128;
1720    end Ureal_2_M_128;
1721
1722    ----------------
1723    -- Ureal_Half --
1724    ----------------
1725
1726    function Ureal_Half return Ureal is
1727    begin
1728       return UR_Half;
1729    end Ureal_Half;
1730
1731    ---------------
1732    -- Ureal_M_0 --
1733    ---------------
1734
1735    function Ureal_M_0 return Ureal is
1736    begin
1737       return UR_M_0;
1738    end Ureal_M_0;
1739
1740    ---------------------
1741    -- Ureal_M_2_10_18 --
1742    ---------------------
1743
1744    function Ureal_M_2_10_18 return Ureal is
1745    begin
1746       return UR_M_2_10_18;
1747    end Ureal_M_2_10_18;
1748
1749    ---------------------
1750    -- Ureal_M_9_10_36 --
1751    ---------------------
1752
1753    function Ureal_M_9_10_36 return Ureal is
1754    begin
1755       return UR_M_9_10_36;
1756    end Ureal_M_9_10_36;
1757
1758    -------------------
1759    -- Ureal_M_10_76 --
1760    -------------------
1761
1762    function Ureal_M_10_76 return Ureal is
1763    begin
1764       return UR_M_10_76;
1765    end Ureal_M_10_76;
1766
1767    -----------------
1768    -- Ureal_Tenth --
1769    -----------------
1770
1771    function Ureal_Tenth return Ureal is
1772    begin
1773       return UR_Tenth;
1774    end Ureal_Tenth;
1775
1776 end Urealp;