Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Numbers/multprec_integer_numbers.adb, Revision 1.1
1.1 ! maekawa 1: with unchecked_deallocation;
! 2:
! 3: package body Multprec_Integer_Numbers is
! 4:
! 5: -- NOTES ON THE CHOICE OF REPRESENTATION AND IMPLEMENTATION :
! 6: -- 0) See also the notes in the body of Multprec_Natural_Numbers.
! 7: -- This package inherits the operations on natural numbers, with
! 8: -- additionally the tests on signs.
! 9: -- Integer numbers are in fact signed natural numbers.
! 10: -- 1) The construction of tagged records was judged not appropriate to
! 11: -- extend the natural numbers, as this construction only applies to
! 12: -- records, it would have changed the privacy of the implementation.
! 13:
! 14: -- DATA STRUCTURE :
! 15:
! 16: type Integer_Number_Rep is record
! 17: plus : boolean;
! 18: numb : Natural_Number;
! 19: end record;
! 20:
! 21: procedure free is
! 22: new unchecked_deallocation(Integer_Number_Rep,Integer_Number);
! 23:
! 24: -- CREATORS :
! 25:
! 26: function Natural_Create ( n : natural ) return Integer_Number is
! 27:
! 28: res : Integer_Number;
! 29: res_rep : Integer_Number_Rep;
! 30:
! 31: begin
! 32: res_rep.plus := true;
! 33: res_rep.numb := Create(n);
! 34: res := new Integer_Number_Rep'(res_rep);
! 35: return res;
! 36: end Natural_Create;
! 37:
! 38: function Create ( n : Array_of_Naturals ) return Integer_Number is
! 39:
! 40: res : Integer_Number;
! 41: res_rep : Integer_Number_Rep;
! 42:
! 43: begin
! 44: res_rep.plus := true;
! 45: res_rep.numb := Create(n);
! 46: res := new Integer_Number_Rep'(res_rep);
! 47: return res;
! 48: end Create;
! 49:
! 50: function Create ( n : Natural_Number ) return Integer_Number is
! 51:
! 52: res : Integer_Number;
! 53: res_rep : Integer_Number_Rep;
! 54:
! 55: begin
! 56: res_rep.plus := true;
! 57: res_rep.numb := +n; --Copy(n,res_rep.numb);
! 58: res := new Integer_Number_Rep'(res_rep);
! 59: return res;
! 60: end Create;
! 61:
! 62: function Create ( i : integer ) return Integer_Number is
! 63:
! 64: res : Integer_Number;
! 65: n : natural;
! 66:
! 67: begin
! 68: if i >= 0
! 69: then n := i;
! 70: res := Natural_Create(n);
! 71: res.plus := true;
! 72: else n := -i;
! 73: res := Natural_Create(n);
! 74: res.plus := false;
! 75: end if;
! 76: return res;
! 77: end Create;
! 78:
! 79: function Convert ( n : Natural_Number ) return Integer_Number is
! 80:
! 81: res : Integer_Number;
! 82: res_rep : Integer_Number_Rep;
! 83:
! 84: begin
! 85: res_rep.numb := n;
! 86: res_rep.plus := true;
! 87: res := new Integer_Number_Rep'(res_rep);
! 88: return res;
! 89: end Convert;
! 90:
! 91: function Create ( i : Integer_Number ) return integer is
! 92:
! 93: res : integer;
! 94: nres : natural;
! 95:
! 96: begin
! 97: if (Empty(i) or else Empty(i.numb))
! 98: then res := 0;
! 99: else nres := Create(i.numb);
! 100: if i.plus
! 101: then res := nres;
! 102: else res := -nres;
! 103: end if;
! 104: end if;
! 105: return res;
! 106: end Create;
! 107:
! 108: -- SELECTORS :
! 109:
! 110: function Empty ( i : Integer_Number ) return boolean is
! 111: begin
! 112: return (i=null);
! 113: end Empty;
! 114:
! 115: function Size ( i : Integer_Number ) return natural is
! 116: begin
! 117: if Empty(i)
! 118: then return 0;
! 119: else return Size(i.numb);
! 120: end if;
! 121: end Size;
! 122:
! 123: function Coefficient ( i : Integer_Number; k : natural ) return natural is
! 124: begin
! 125: if (Empty(i) or else (k > Size(i)))
! 126: then return 0;
! 127: else return Coefficient(i.numb,k);
! 128: end if;
! 129: end Coefficient;
! 130:
! 131: function Coefficients ( i : Integer_Number ) return Array_of_Naturals is
! 132:
! 133: nullres : Array_of_Naturals(0..0) := (0..0 => 0);
! 134:
! 135: begin
! 136: if not Empty(i)
! 137: then return Coefficients(i.numb);
! 138: else return nullres;
! 139: end if;
! 140: end Coefficients;
! 141:
! 142: function Decimal_Places ( i : Integer_Number ) return natural is
! 143: begin
! 144: if Empty(i)
! 145: then return 0;
! 146: else return Decimal_Places(i.numb);
! 147: end if;
! 148: end Decimal_Places;
! 149:
! 150: function Positive ( i : Integer_Number ) return boolean is
! 151: begin
! 152: if Empty(i)
! 153: then return false;
! 154: elsif Empty(i.numb)
! 155: then return false;
! 156: -- elsif Equal(i.numb,0) -- whatever sign you wish to give to 0
! 157: -- then return false; -- convenient to work with for input
! 158: else return i.plus;
! 159: end if;
! 160: end Positive;
! 161:
! 162: function Negative ( i : Integer_Number ) return boolean is
! 163: begin
! 164: if Empty(i)
! 165: then return false;
! 166: elsif Empty(i.numb)
! 167: then return false;
! 168: -- elsif Equal(i.numb,0) -- for input of floating-point numbers
! 169: -- then return false; -- convenient for reading -0.01
! 170: else return not i.plus;
! 171: end if;
! 172: end Negative;
! 173:
! 174: function Sign ( i : Integer_Number ) return integer is
! 175: begin
! 176: if Empty(i) or Equal(i,0)
! 177: then return 0;
! 178: elsif Positive(i)
! 179: then return +1;
! 180: else return -1;
! 181: end if;
! 182: end Sign;
! 183:
! 184: function Unsigned ( i : Integer_Number ) return Natural_Number is
! 185:
! 186: res : Natural_Number;
! 187:
! 188: begin
! 189: if not Empty(i)
! 190: then res := i.numb;
! 191: end if;
! 192: return res;
! 193: end Unsigned;
! 194:
! 195: -- COMPARISON AND COPYING :
! 196:
! 197: function Equal ( i1 : Integer_Number; i2 : integer ) return boolean is
! 198: begin
! 199: if Empty(i1)
! 200: then return (i2 = 0);
! 201: elsif ((i1.plus and i2 < 0) or else (not i1.plus and i2 > 0))
! 202: then return false;
! 203: elsif Empty(i1.numb)
! 204: then if i2 = 0
! 205: then return true;
! 206: else return false;
! 207: end if;
! 208: elsif i2 >= 0
! 209: then return Equal(i1.numb,i2);
! 210: else return Equal(i1.numb,-i2);
! 211: end if;
! 212: end Equal;
! 213:
! 214: function Equal ( i1,i2 : Integer_Number ) return boolean is
! 215: begin
! 216: if Empty(i1)
! 217: then return Equal(i2,0);
! 218: elsif Empty(i2)
! 219: then return Equal(i1,0);
! 220: else if (Positive(i1) and Negative(i2))
! 221: or else (Negative(i1) and Positive(i2))
! 222: then return false;
! 223: else return Equal(i1.numb,i2.numb);
! 224: end if;
! 225: end if;
! 226: end Equal;
! 227:
! 228: function "<" ( i1 : Integer_Number; i2 : integer ) return boolean is
! 229: begin
! 230: if Empty(i1)
! 231: then return (i2 > 0);
! 232: else if Positive(i1)
! 233: then if i2 <= 0
! 234: then return false;
! 235: else return (i1.numb < i2);
! 236: end if;
! 237: elsif Negative(i1)
! 238: then if i2 >= 0
! 239: then return true;
! 240: else return (i1.numb > -i2);
! 241: end if;
! 242: else return (i2 > 0);
! 243: end if;
! 244: end if;
! 245: end "<";
! 246:
! 247: function "<" ( i1 : integer; i2 : Integer_Number ) return boolean is
! 248: begin
! 249: if Empty(i2)
! 250: then return (i1 < 0);
! 251: else if Positive(i2)
! 252: then if i1 <= 0
! 253: then return true;
! 254: else return (i1 < i2.numb);
! 255: end if;
! 256: elsif Negative(i2)
! 257: then if i1 >= 0
! 258: then return false;
! 259: else return (-i1 > i2.numb);
! 260: end if;
! 261: else return (i1 < 0);
! 262: end if;
! 263: end if;
! 264: end "<";
! 265:
! 266: function "<" ( i1,i2 : Integer_Number ) return boolean is
! 267: begin
! 268: if Empty(i1)
! 269: then return Positive(i2);
! 270: elsif Empty(i2)
! 271: then return Negative(i1);
! 272: elsif Positive(i1)
! 273: then if Negative(i2)
! 274: then return false;
! 275: else return (i1.numb < i2.numb);
! 276: end if;
! 277: elsif Negative(i1)
! 278: then if Positive(i2)
! 279: then return true;
! 280: else return (i1.numb > i2.numb);
! 281: end if;
! 282: else return Positive(i2);
! 283: end if;
! 284: end "<";
! 285:
! 286: function ">" ( i1 : Integer_Number; i2 : integer ) return boolean is
! 287: begin
! 288: if Empty(i1)
! 289: then return (i2 < 0);
! 290: else if Negative(i1)
! 291: then if i2 >= 0
! 292: then return false;
! 293: else return (i1.numb < -i2);
! 294: end if;
! 295: elsif Positive(i1)
! 296: then if i2 <= 0
! 297: then return true;
! 298: else return (i1.numb > i2);
! 299: end if;
! 300: else return (i2 < 0);
! 301: end if;
! 302: end if;
! 303: end ">";
! 304:
! 305: function ">" ( i1 : integer; i2 : Integer_Number ) return boolean is
! 306: begin
! 307: if Empty(i2)
! 308: then return (i1 > 0);
! 309: else if Positive(i2)
! 310: then if i1 <= 0
! 311: then return false;
! 312: else return (i1 > i2.numb);
! 313: end if;
! 314: elsif Negative(i2)
! 315: then if i1 >= 0
! 316: then return true;
! 317: else return (-i1 < i2.numb);
! 318: end if;
! 319: else return (i1 > 0);
! 320: end if;
! 321: end if;
! 322: end ">";
! 323:
! 324: function ">" ( i1,i2 : Integer_Number ) return boolean is
! 325: begin
! 326: if Empty(i1)
! 327: then return Negative(i2);
! 328: elsif Empty(i2)
! 329: then return Positive(i1);
! 330: elsif Positive(i1)
! 331: then if Negative(i2)
! 332: then return true;
! 333: else return (i1.numb > i2.numb);
! 334: end if;
! 335: elsif Negative(i1)
! 336: then if Positive(i2)
! 337: then return false;
! 338: else return (i1.numb < i2.numb);
! 339: end if;
! 340: else return Negative(i2);
! 341: end if;
! 342: end ">";
! 343:
! 344: procedure Copy ( i1 : in integer; i2 : in out Integer_Number ) is
! 345: begin
! 346: Clear(i2);
! 347: i2 := Create(i1);
! 348: end Copy;
! 349:
! 350: procedure Copy ( i1 : in Integer_Number; i2 : in out Integer_Number ) is
! 351: begin
! 352: Clear(i2);
! 353: if not Empty(i1)
! 354: then declare
! 355: i2rep : Integer_Number_Rep;
! 356: begin
! 357: i2rep.plus := i1.plus;
! 358: i2rep.numb := +i1.numb;
! 359: i2 := new Integer_Number_Rep'(i2rep);
! 360: end;
! 361: end if;
! 362: end Copy;
! 363:
! 364: -- ARITHMETIC OPERATIONS as functions :
! 365:
! 366: function "+" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
! 367:
! 368: res : Integer_Number;
! 369: res_rep : Integer_Number_Rep;
! 370: n : natural;
! 371:
! 372: begin
! 373: if (Empty(i1) or else Empty(i1.numb))
! 374: then res := Create(i2);
! 375: else if i1.plus
! 376: then if i2 >= 0
! 377: then n := i2;
! 378: res_rep.plus := true;
! 379: res_rep.numb := i1.numb + n;
! 380: res := new Integer_Number_Rep'(res_rep);
! 381: else n := -i2;
! 382: if not Equal(i1.numb,n)
! 383: then if i1.numb > n
! 384: then res_rep.plus := true;
! 385: res_rep.numb := i1.numb - n;
! 386: else res_rep.plus := false;
! 387: res_rep.numb := n - i1.numb;
! 388: end if;
! 389: res := new Integer_Number_Rep'(res_rep);
! 390: end if;
! 391: end if;
! 392: else if i2 <= 0
! 393: then n := -i2;
! 394: res_rep.plus := false;
! 395: res_rep.numb := i1.numb + n;
! 396: res := new Integer_Number_Rep'(res_rep);
! 397: else n := i2;
! 398: if not Equal(i1.numb,n)
! 399: then if i1.numb < n
! 400: then res_rep.plus := true;
! 401: res_rep.numb := n - i1.numb;
! 402: else res_rep.plus := false;
! 403: res_rep.numb := i1.numb - n;
! 404: end if;
! 405: res := new Integer_Number_Rep'(res_rep);
! 406: end if;
! 407: end if;
! 408: end if;
! 409: end if;
! 410: return res;
! 411: end "+";
! 412:
! 413: function "+" ( i1 : integer; i2 : Integer_Number ) return Integer_Number is
! 414: begin
! 415: return (i2+i1);
! 416: end "+";
! 417:
! 418: function "+" ( i1,i2 : Integer_Number ) return Integer_Number is
! 419:
! 420: res : Integer_Number;
! 421: res_rep : Integer_Number_Rep;
! 422:
! 423: begin
! 424: if (Empty(i1) or else Empty(i1.numb))
! 425: then Copy(i2,res);
! 426: else if (Empty(i2) or else Empty(i2.numb))
! 427: then Copy(i1,res);
! 428: else if i1.plus
! 429: then if i2.plus
! 430: then res_rep.plus := true;
! 431: res_rep.numb := i1.numb + i2.numb;
! 432: res := new Integer_Number_Rep'(res_rep);
! 433: else if not Equal(i1.numb,i2.numb)
! 434: then if i1.numb > i2.numb
! 435: then res_rep.plus := true;
! 436: res_rep.numb := i1.numb - i2.numb;
! 437: else res_rep.plus := false;
! 438: res_rep.numb := i2.numb - i1.numb;
! 439: end if;
! 440: res := new Integer_Number_Rep'(res_rep);
! 441: end if;
! 442: end if;
! 443: else if not i2.plus
! 444: then res_rep.plus := false;
! 445: res_rep.numb := i1.numb + i2.numb;
! 446: res := new Integer_Number_Rep'(res_rep);
! 447: else if not Equal(i1.numb,i2.numb)
! 448: then if i1.numb < i2.numb
! 449: then res_rep.plus := true;
! 450: res_rep.numb := i2.numb - i1.numb;
! 451: else res_rep.plus := false;
! 452: res_rep.numb := i1.numb - i2.numb;
! 453: end if;
! 454: res := new Integer_Number_Rep'(res_rep);
! 455: end if;
! 456: end if;
! 457: end if;
! 458: end if;
! 459: end if;
! 460: return res;
! 461: end "+";
! 462:
! 463: function "+" ( i : Integer_Number ) return Integer_Number is
! 464:
! 465: res : Integer_Number;
! 466:
! 467: begin
! 468: Copy(i,res);
! 469: return res;
! 470: end "+";
! 471:
! 472: function "-" ( i : Integer_Number ) return Integer_Number is
! 473:
! 474: res : Integer_Number;
! 475: res_rep : Integer_Number_Rep;
! 476:
! 477: begin
! 478: if not Empty(i)
! 479: then res_rep.plus := not i.plus;
! 480: res_rep.numb := +i.numb; -- Copy(i.numb,res_rep.numb);
! 481: res := new Integer_Number_Rep'(res_rep);
! 482: end if;
! 483: return res;
! 484: end "-";
! 485:
! 486: function "-" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
! 487:
! 488: mini2 : constant integer := -i2;
! 489:
! 490: begin
! 491: return (i1+mini2);
! 492: end "-";
! 493:
! 494: function "-" ( i1 : integer; i2 : Integer_Number ) return Integer_Number is
! 495:
! 496: res : Integer_Number := i2 - i1;
! 497:
! 498: begin
! 499: Min(res);
! 500: return res;
! 501: end "-";
! 502:
! 503: function "-" ( i1,i2 : Integer_Number ) return Integer_Number is
! 504:
! 505: res,mini2 : Integer_Number;
! 506: mini2rep : Integer_Number_Rep;
! 507:
! 508: begin
! 509: if (Empty(i2) or else Empty(i2.numb))
! 510: then Copy(i1,res);
! 511: else mini2rep.numb := i2.numb;
! 512: mini2rep.plus := not i2.plus;
! 513: mini2 := new Integer_Number_Rep'(mini2rep);
! 514: res := i1 + mini2;
! 515: free(mini2);
! 516: end if;
! 517: return res;
! 518: end "-";
! 519:
! 520: function "*" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
! 521:
! 522: res : Integer_Number;
! 523: res_rep : Integer_Number_Rep;
! 524: n : natural;
! 525:
! 526: begin
! 527: if not ((i2 = 0) or else Empty(i1) or else Empty(i1.numb))
! 528: then if i2 > 0
! 529: then n := i2;
! 530: res_rep.plus := i1.plus;
! 531: else n := -i2;
! 532: res_rep.plus := not i1.plus;
! 533: end if;
! 534: res_rep.numb := i1.numb*n;
! 535: res := new Integer_Number_Rep'(res_rep);
! 536: end if;
! 537: return res;
! 538: end "*";
! 539:
! 540: function "*" ( i1 : integer; i2 : Integer_Number ) return Integer_Number is
! 541: begin
! 542: return (i2*i1);
! 543: end "*";
! 544:
! 545: function "*" ( i1,i2 : Integer_Number ) return Integer_Number is
! 546:
! 547: res : Integer_Number;
! 548: res_rep : Integer_Number_Rep;
! 549:
! 550: begin
! 551: if (not (Empty(i1) or else Empty(i1.numb)))
! 552: and then (not (Empty(i2) or else Empty(i2.numb)))
! 553: then res_rep.numb := i1.numb*i2.numb;
! 554: res_rep.plus := i1.plus;
! 555: if not i2.plus
! 556: then res_rep.plus := not res_rep.plus;
! 557: end if;
! 558: res := new Integer_Number_Rep'(res_rep);
! 559: end if;
! 560: return res;
! 561: end "*";
! 562:
! 563: function "**" ( i : Integer_Number; n : natural ) return Integer_Number is
! 564:
! 565: res : Integer_Number;
! 566: res_rep : Integer_Number_Rep;
! 567:
! 568: begin
! 569: if n = 0
! 570: then res := Create(1);
! 571: else if not (Empty(i) or else Empty(i.numb))
! 572: then res_rep.numb := i.numb**n;
! 573: res_rep.plus := i.plus;
! 574: if ((not i.plus) and then (n mod 2 = 1))
! 575: then res_rep.plus := not res_rep.plus;
! 576: end if;
! 577: res := new Integer_Number_Rep'(res_rep);
! 578: end if;
! 579: end if;
! 580: return res;
! 581: end "**";
! 582:
! 583: function "**" ( i : integer; n : Natural_Number ) return Integer_Number is
! 584:
! 585: res : Integer_Number;
! 586: res_rep : Integer_Number_Rep;
! 587: ni : natural;
! 588:
! 589: begin
! 590: if (Empty(n) or else Equal(n,0))
! 591: then res := Create(1);
! 592: else if i /= 0
! 593: then if i > 0
! 594: then ni := i;
! 595: res_rep.plus := true;
! 596: else ni := -i;
! 597: res_rep.plus := false;
! 598: end if;
! 599: res_rep.numb := ni**n;
! 600: if (i < 0 and then (Rmd(n,2) = 0))
! 601: then res_rep.plus := not res_rep.plus;
! 602: end if;
! 603: res := new Integer_Number_Rep'(res_rep);
! 604: end if;
! 605: end if;
! 606: return res;
! 607: end "**";
! 608:
! 609: function "**" ( i : Integer_Number; n : Natural_Number )
! 610: return Integer_Number is
! 611:
! 612: res : Integer_Number;
! 613: res_rep : Integer_Number_Rep;
! 614:
! 615: begin
! 616: if (Empty(n) or else Equal(n,0))
! 617: then res := Create(1);
! 618: else if not (Empty(i) or else Empty(i.numb))
! 619: then res_rep.numb := i.numb**n;
! 620: res_rep.plus := i.plus;
! 621: if ((not i.plus) and then (Rmd(n,2) = 0))
! 622: then res_rep.plus := not res_rep.plus;
! 623: end if;
! 624: res := new Integer_Number_Rep'(res_rep);
! 625: end if;
! 626: end if;
! 627: return res;
! 628: end "**";
! 629:
! 630: function "/" ( i1 : Integer_Number; i2 : integer ) return Integer_Number is
! 631:
! 632: res : Integer_Number;
! 633: i2n : natural;
! 634: res_rep : Integer_Number_Rep;
! 635:
! 636: begin
! 637: if i2 /= 0
! 638: then if not (Empty(i1) or else Empty(i1.numb))
! 639: then if i2 > 0
! 640: then i2n := i2;
! 641: else i2n := -i2;
! 642: end if;
! 643: res_rep.numb := i1.numb/i2n;
! 644: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
! 645: then res_rep.plus := true;
! 646: else res_rep.plus := false;
! 647: end if;
! 648: res := new Integer_Number_Rep'(res_rep);
! 649: end if;
! 650: else raise NUMERIC_ERROR;
! 651: end if;
! 652: return res;
! 653: end "/";
! 654:
! 655: function "/" ( i1 : integer; i2 : Integer_Number ) return integer is
! 656:
! 657: res : integer;
! 658: i1n,nres : natural;
! 659:
! 660: begin
! 661: if (Empty(i2) or else Empty(i2.numb))
! 662: then raise NUMERIC_ERROR;
! 663: else if i1 > 0
! 664: then i1n := i1;
! 665: else i1n := -i1;
! 666: end if;
! 667: nres := i1n/i2.numb;
! 668: if ((i1 > 0) and i2.plus) or ((i1 < 0) and (not i2.plus))
! 669: then res := nres;
! 670: else res := -nres;
! 671: end if;
! 672: end if;
! 673: return res;
! 674: end "/";
! 675:
! 676: function "/" ( i1,i2 : Integer_Number ) return Integer_Number is
! 677:
! 678: res : Integer_Number;
! 679: res_rep : Integer_Number_Rep;
! 680:
! 681: begin
! 682: if not (Empty(i1) or else Empty(i1.numb))
! 683: then if (Empty(i2) or else Empty(i2.numb))
! 684: then raise NUMERIC_ERROR;
! 685: else res_rep.numb := i1.numb/i2.numb;
! 686: if (i1.plus and i2.plus) or ((not i1.plus) and (not i2.plus))
! 687: then res_rep.plus := true;
! 688: else res_rep.plus := false;
! 689: end if;
! 690: res := new Integer_Number_Rep'(res_rep);
! 691: end if;
! 692: end if;
! 693: return res;
! 694: end "/";
! 695:
! 696: function Rmd ( i1 : Integer_Number; i2 : integer ) return integer is
! 697:
! 698: res : integer;
! 699: i2n,nres : natural;
! 700:
! 701: begin
! 702: if i2 /= 0
! 703: then if (Empty(i1) or else Empty(i1.numb))
! 704: then res := 0;
! 705: else if i2 > 0
! 706: then i2n := i2;
! 707: else i2n := -i2;
! 708: end if;
! 709: nres := Rmd(i1.numb,i2n);
! 710: if i1.plus
! 711: then res := nres;
! 712: else res := -nres;
! 713: end if;
! 714: end if;
! 715: else raise NUMERIC_ERROR;
! 716: end if;
! 717: return res;
! 718: end Rmd;
! 719:
! 720: function Rmd ( i1 : integer; i2 : Integer_Number ) return integer is
! 721:
! 722: res : integer;
! 723: i1n,nres : natural;
! 724:
! 725: begin
! 726: if i1 = 0
! 727: then res := 0;
! 728: else if (Empty(i2) or else Empty(i2.numb))
! 729: then raise NUMERIC_ERROR;
! 730: else if i1 > 0
! 731: then i1n := i1;
! 732: else i1n := -i1;
! 733: end if;
! 734: nres := Rmd(i1n,i2.numb);
! 735: if i1 > 0
! 736: then res := nres;
! 737: else res := -nres;
! 738: end if;
! 739: end if;
! 740: end if;
! 741: return res;
! 742: end Rmd;
! 743:
! 744: function Rmd ( i1,i2 : Integer_Number ) return Integer_Number is
! 745:
! 746: res : Integer_Number;
! 747: res_rep : Integer_Number_Rep;
! 748:
! 749: begin
! 750: if not (Empty(i1) or else Empty(i1.numb))
! 751: then if (Empty(i2) or else Empty(i2.numb))
! 752: then raise NUMERIC_ERROR;
! 753: else res_rep.numb := Rmd(i1.numb,i2.numb);
! 754: res_rep.plus := i1.plus;
! 755: res := new Integer_Number_Rep'(res_rep);
! 756: end if;
! 757: end if;
! 758: return res;
! 759: end Rmd;
! 760:
! 761: -- ARITHMETIC OPERATIONS as procedures for memory management :
! 762:
! 763: procedure Add ( i1 : in out Integer_Number; i2 : in integer ) is
! 764:
! 765: n : natural;
! 766: nn : Natural_Number;
! 767:
! 768: begin
! 769: if (Empty(i1) or else Empty(i1.numb))
! 770: then i1 := Create(i2);
! 771: else if i1.plus
! 772: then if i2 >= 0
! 773: then n := i2;
! 774: Add(i1.numb,n);
! 775: else n := -i2;
! 776: if not Equal(i1.numb,n)
! 777: then if i1.numb > n
! 778: then Sub(i1.numb,n);
! 779: else i1.plus := false;
! 780: nn := Create(n);
! 781: Sub(nn,i1.numb);
! 782: Clear(i1.numb); i1.numb := nn;
! 783: end if;
! 784: else Clear(i1);
! 785: end if;
! 786: end if;
! 787: else if i2 <= 0
! 788: then n := -i2;
! 789: Add(i1.numb,n);
! 790: else n := i2;
! 791: if not Equal(i1.numb,n)
! 792: then if i1.numb < n
! 793: then i1.plus := true;
! 794: nn := Create(n);
! 795: Sub(nn,i1.numb);
! 796: Clear(i1.numb); i1.numb := nn;
! 797: else Sub(i1.numb,n);
! 798: end if;
! 799: else Clear(i1);
! 800: end if;
! 801: end if;
! 802: end if;
! 803: end if;
! 804: end Add;
! 805:
! 806: procedure Add ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
! 807:
! 808: nn : Natural_Number;
! 809:
! 810: begin
! 811: if (Empty(i1) or else Empty(i1.numb))
! 812: then Copy(i2,i1);
! 813: else if not (Empty(i2) or else Empty(i2.numb))
! 814: then if i1.plus
! 815: then if i2.plus
! 816: then Add(i1.numb,i2.numb);
! 817: else if not Equal(i1.numb,i2.numb)
! 818: then if i1.numb > i2.numb
! 819: then Sub(i1.numb,i2.numb);
! 820: else Copy(i2.numb,nn);
! 821: Sub(nn,i1.numb);
! 822: Clear(i1.numb);
! 823: i1.plus := false;
! 824: i1.numb := nn;
! 825: end if;
! 826: else Clear(i1);
! 827: end if;
! 828: end if;
! 829: else if not i2.plus
! 830: then Add(i1.numb,i2.numb);
! 831: else if not Equal(i1.numb,i2.numb)
! 832: then if i1.numb < i2.numb
! 833: then Copy(i2.numb,nn);
! 834: Sub(nn,i1.numb);
! 835: Clear(i1.numb);
! 836: i1.plus := true;
! 837: i1.numb := nn;
! 838: else Sub(i1.numb,i2.numb);
! 839: end if;
! 840: else Clear(i1);
! 841: end if;
! 842: end if;
! 843: end if;
! 844: end if;
! 845: end if;
! 846: end Add;
! 847:
! 848: procedure Min ( i : in out Integer_Number ) is
! 849: begin
! 850: if not Empty(i)
! 851: then i.plus := not i.plus;
! 852: end if;
! 853: end Min;
! 854:
! 855: procedure Sub ( i1 : in out Integer_Number; i2 : in integer ) is
! 856: begin
! 857: Add(i1,-i2);
! 858: end Sub;
! 859:
! 860: procedure Sub ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
! 861:
! 862: mini2 : Integer_Number;
! 863: mini2rep : Integer_Number_Rep;
! 864:
! 865: begin
! 866: if not (Empty(i2) or else Empty(i2.numb))
! 867: then mini2rep.numb := i2.numb;
! 868: mini2rep.plus := not i2.plus;
! 869: mini2 := new Integer_Number_Rep'(mini2rep);
! 870: Add(i1,mini2);
! 871: free(mini2);
! 872: end if;
! 873: end Sub;
! 874:
! 875: procedure Mul ( i1 : in out Integer_Number; i2 : in integer ) is
! 876:
! 877: n : natural;
! 878:
! 879: begin
! 880: if not (Empty(i1) or else Empty(i1.numb))
! 881: then if i2 = 0
! 882: then Clear(i1);
! 883: else if i2 > 0
! 884: then n := i2;
! 885: else n := -i2;
! 886: i1.plus := not i1.plus;
! 887: end if;
! 888: Mul(i1.numb,n);
! 889: end if;
! 890: end if;
! 891: end Mul;
! 892:
! 893: procedure Mul ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
! 894: begin
! 895: if (not (Empty(i1) or else Empty(i1.numb)))
! 896: then if (Empty(i2) or else Empty(i2.numb))
! 897: then Clear(i1);
! 898: else Mul(i1.numb,i2.numb);
! 899: if not i2.plus
! 900: then i1.plus := not i1.plus;
! 901: end if;
! 902: end if;
! 903: end if;
! 904: end Mul;
! 905:
! 906: procedure Rmd ( i1 : in out Integer_Number; i2 : in integer ) is
! 907:
! 908: res : Integer_Number := Create(Rmd(i1,i2));
! 909:
! 910: begin
! 911: Clear(i1); i1 := res;
! 912: end Rmd;
! 913:
! 914: procedure Rmd ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
! 915:
! 916: res : Integer_Number := Rmd(i1,i2);
! 917:
! 918: begin
! 919: Clear(i1); i1 := res;
! 920: end Rmd;
! 921:
! 922: procedure Div ( i1 : in out Integer_Number; i2 : in integer ) is
! 923:
! 924: r : integer;
! 925:
! 926: begin
! 927: Div(i1,i2,r);
! 928: end Div;
! 929:
! 930: procedure Div ( i1 : in out Integer_Number; i2 : in Integer_Number ) is
! 931:
! 932: r : Integer_Number;
! 933:
! 934: begin
! 935: Div(i1,i2,r);
! 936: Clear(r);
! 937: end Div;
! 938:
! 939: procedure Div ( i1 : in Integer_Number; i2 : in integer;
! 940: q : out Integer_Number; r : out integer ) is
! 941:
! 942: qrep : Integer_Number_Rep;
! 943: i2n,rn : natural;
! 944:
! 945: begin
! 946: if i2 /= 0
! 947: then if not (Empty(i1) or else Empty(i1.numb))
! 948: then if i2 > 0
! 949: then i2n := i2;
! 950: else i2n := -i2;
! 951: end if;
! 952: Div(i1.numb,i2n,qrep.numb,rn);
! 953: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
! 954: then qrep.plus := true;
! 955: else qrep.plus := false;
! 956: end if;
! 957: q := new Integer_Number_Rep'(qrep);
! 958: if i1.plus
! 959: then r := rn;
! 960: else r := -rn;
! 961: end if;
! 962: end if;
! 963: else raise NUMERIC_ERROR;
! 964: end if;
! 965: end Div;
! 966:
! 967: procedure Div ( i1 : in out Integer_Number; i2 : in integer;
! 968: r : out integer ) is
! 969:
! 970: i2n,rn : natural;
! 971:
! 972: begin
! 973: if i2 /= 0
! 974: then if not (Empty(i1) or else Empty(i1.numb))
! 975: then if i2 > 0
! 976: then i2n := i2;
! 977: else i2n := -i2;
! 978: end if;
! 979: Div(i1.numb,i2n,rn);
! 980: if i1.plus
! 981: then r := rn;
! 982: else r := -rn;
! 983: end if;
! 984: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
! 985: then i1.plus := true;
! 986: else i1.plus := false;
! 987: end if;
! 988: end if;
! 989: else raise NUMERIC_ERROR;
! 990: end if;
! 991: end Div;
! 992:
! 993: procedure Div ( i1,i2 : in Integer_Number; q,r : out Integer_Number ) is
! 994:
! 995: qrep,rrep : Integer_Number_Rep;
! 996:
! 997: begin
! 998: if not (Empty(i2) or else Empty(i2.numb))
! 999: then if not (Empty(i1) or else Empty(i1.numb))
! 1000: then Div(i1.numb,i2.numb,qrep.numb,rrep.numb);
! 1001: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
! 1002: then qrep.plus := true;
! 1003: else qrep.plus := false;
! 1004: end if;
! 1005: q := new Integer_Number_Rep'(qrep);
! 1006: rrep.plus := i1.plus;
! 1007: r := new Integer_Number_Rep'(rrep);
! 1008: end if;
! 1009: else raise NUMERIC_ERROR;
! 1010: end if;
! 1011: end Div;
! 1012:
! 1013: procedure Div ( i1 : in out Integer_Number; i2 : in Integer_Number;
! 1014: r : out Integer_Number ) is
! 1015:
! 1016: rrep : Integer_Number_Rep;
! 1017:
! 1018: begin
! 1019: if not (Empty(i2) or else Empty(i2.numb))
! 1020: then if not (Empty(i1) or else Empty(i1.numb))
! 1021: then Div(i1.numb,i2.numb,rrep.numb);
! 1022: rrep.plus := i1.plus;
! 1023: r := new Integer_Number_Rep'(rrep);
! 1024: if (i1.plus and (i2 > 0)) or ((not i1.plus) and (i2 < 0))
! 1025: then i1.plus := true;
! 1026: else i1.plus := false;
! 1027: end if;
! 1028: end if;
! 1029: else raise NUMERIC_ERROR;
! 1030: end if;
! 1031: end Div;
! 1032:
! 1033: -- DESTRUCTOR :
! 1034:
! 1035: procedure Clear ( i : in out Integer_Number ) is
! 1036: begin
! 1037: if not Empty(i)
! 1038: then Clear(i.numb);
! 1039: free(i);
! 1040: i := null;
! 1041: end if;
! 1042: end Clear;
! 1043:
! 1044: end Multprec_Integer_Numbers;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to multprec_integer_numbers.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Numbers