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