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