src/dynpmc/rational.pmc

   1 /*
   2 Copyright (C) 2008, The Perl Foundation.
   3 $Id$
   4
   5 =pod
   6
   7 =head1 NAME
   8
   9 src/dynpmc/rational.pmc - Rational numbers PMC
  10
  11 =head1 DESCRIPTION
  12
  13 Rational is currently going to get implemented. It uses the GNU Multiple Precision (GMP) library,
  14 like BigInt, because implementation with integers would be too unstable and inaccurate.
  15
  16 'LispRational' will subclass this.
  17
  18 You may use Rational with any of parrot's basic data types as well as with String-, Integer- and
  19 Float-PMCs.
  20
  21 =head1 Functions
  22
  23 Currently C<rational.pmc> only has some C<static> functions for code sharing.
  24
  25 =over 4
  26
  27 =cut
  28
  29 */
  30
  31 #include "parrot/has_header.h"
  32
  33 #ifdef PARROT_HAS_GMP
  34 #  include <gmp.h>
  35    typedef struct RATIONAL {
  36       mpq_t q;
  37    } RATIONAL;
  38 #  define RT(x)         ((RATIONAL*) PMC_struct_val(x))->q
  39 #else
  40 #  define RT(x)
  41 #endif
  42
  43 #define RAISE_EXCEPTION   Parrot_ex_throw_from_c_args(interp, NULL, \
  44     EXCEPTION_LIBRARY_NOT_LOADED, "GNU Multiple Precision library not found.");
  45
  46 /*
  47
  48 =item * static STRING *rat_get_string_to_base(PARROT_INTERP, PMC *self, int base)
  49
  50 Returns a string representation of a Rational-PMC to a certain base.
  51
  52 =cut
  53
  54 */
  55 static STRING *rat_get_string_to_base(PARROT_INTERP, PMC *self, int base) {
  56   #ifdef PARROT_HAS_GMP
  57     STRING *pstr;
  58     char *cstr = mpq_get_str(NULL, (int) base, RT(self));
  59     pstr = string_from_cstring(interp, cstr, 0);
  60     string_cstring_free(cstr);
  61     return pstr;
  62   #else
  63     RAISE_EXCEPTION
  64   #endif
  65 }
  66
  67 /*
  68
  69 =item * static void rat_add_integer(PARROT_INTERP, PMC *self, int value, PMC *dest)
  70
  71 Adds an integer "value" to a Rational-PMC and stores the result in (another) Rational-PMC.
  72
  73 =cut
  74
  75 */
  76 static void rat_add_integer(PARROT_INTERP, PMC *self, int value, PMC *dest) {
  77   #ifdef PARROT_HAS_GMP
  78     mpq_t t;
  79
  80     if (dest) {
  81         if (self != dest)
  82             VTABLE_morph(interp, dest, self->vtable->base_type);
  83     }
  84     else {
  85         dest = pmc_new(interp, self->vtable->base_type);
  86     }
  87
  88     mpq_init(t);
  89     mpq_set_si(t, (int) value, 1);
  90     mpq_add(RT(dest), RT(self), t);
  91     mpq_clear(t);
  92   #else
  93     RAISE_EXCEPTION
  94   #endif
  95 }
  96
  97 /*
  98
  99 =item * static void rat_add_float(PARROT_INTERP, PMC *self, double value, PMC *dest)
 100
 101 Adds a float "value" to a Rational-PMC and stores the result in (another) Rational-PMC. "value" is
 102 first conveted to a rational using GMPs mpq_set_d-function. This is meant to be exact.
 103
 104 =cut
 105
 106 */
 107 static void rat_add_float(PARROT_INTERP, PMC *self, double value, PMC *dest) {
 108   #ifdef PARROT_HAS_GMP
 109     mpq_t t;
 110
 111     if (dest)
 112         VTABLE_morph(interp, dest, self->vtable->base_type);
 113     else
 114         dest = pmc_new(interp, self->vtable->base_type);
 115
 116     mpq_init(t);
 117     mpq_set_d(t, (double) value);
 118     mpq_add(RT(dest), RT(self), t);
 119     mpq_clear(t);
 120   #else
 121     RAISE_EXCEPTION
 122   #endif
 123 }
 124
 125 /*
 126
 127 =item * static void rat_multiply_integer(PARROT_INTERP, PMC *self, int value, PMC *dest)
 128
 129 Multiplys a Rational-PMC with an integer "value" and stores the result in (another) Rational-PMC.
 130
 131 =cut
 132
 133 */
 134 static void rat_multiply_integer(PARROT_INTERP, PMC *self, int value, PMC *dest) {
 135   #ifdef PARROT_HAS_GMP
 136     if (dest)
 137         VTABLE_morph(interp, dest, self->vtable->base_type);
 138     else
 139         dest = pmc_new(interp, self->vtable->base_type);
 140
 141     mpz_mul_ui(mpq_numref(RT(dest)), mpq_numref(RT(self)), (unsigned int) value);
 142     mpq_set_den(RT(dest), mpq_denref(RT(self)));
 143   #else
 144     RAISE_EXCEPTION
 145   #endif
 146 }
 147
 148 /*
 149
 150 =item * static void rat_multiply_float(PARROT_INTERP, PMC *self, double value, PMC *dest)
 151
 152 Multiplies a Rational-PMC with a float "value" and stores the result in (another) Rational-PMC.
 153
 154 =cut
 155
 156 */
 157 static void rat_multiply_float(PARROT_INTERP, PMC *self, double value, PMC *dest) {
 158   #ifdef PARROT_HAS_GMP
 159     mpq_t t;
 160
 161     if (dest)
 162         VTABLE_morph(interp, dest, self->vtable->base_type);
 163     else
 164         dest = pmc_new(interp, self->vtable->base_type);
 165
 166     mpq_init(t);
 167     mpq_set_d(t, (double) value);
 168     mpq_mul(RT(dest), RT(self), t);
 169     mpq_clear(t);
 170   #else
 171     RAISE_EXCEPTION
 172   #endif
 173 }
 174
 175 /*
 176
 177 =item * static void rat_divide_integer(PARROT_INTERP, PMC *self, int value, PMC *dest)
 178
 179 Divides a Rational-PMC through an integer "value" and stores the result in (another) Rational-PMC.
 180
 181 =cut
 182
 183 */
 184 static void rat_divide_integer(PARROT_INTERP, PMC *self, int value, PMC *dest) {
 185   #ifdef PARROT_HAS_GMP
 186     mpq_t t;
 187
 188     if (dest)
 189         VTABLE_morph(interp, dest, self->vtable->base_type);
 190     else
 191         dest = pmc_new(interp, self->vtable->base_type);
 192
 193     mpq_init(t);
 194     mpq_set_si(t, (int) value, 1);
 195     mpq_div(RT(dest), RT(self), t);
 196     mpq_clear(t);
 197   #else
 198     RAISE_EXCEPTION
 199   #endif
 200 }
 201
 202 /*
 203
 204 =item * static void rat_divide_float(PARROT_INTERP, PMC *self, double value, PMC *dest)
 205
 206 Divides a Rational-PMC through a float "value" and stores the result in (another) Rational-PMC.
 207
 208 =cut
 209
 210 */
 211 static void rat_divide_float(PARROT_INTERP, PMC *self, double value, PMC *dest) {
 212   #ifdef PARROT_HAS_GMP
 213     mpq_t t;
 214
 215     if (dest)
 216         VTABLE_morph(interp, dest, self->vtable->base_type);
 217     else
 218         dest = pmc_new(interp, self->vtable->base_type);
 219
 220     mpq_init(t);
 221     mpq_set_d(t, (double) value);
 222     mpq_div(RT(dest), RT(self), t);
 223     mpq_clear(t);
 224   #else
 225     RAISE_EXCEPTION
 226   #endif
 227 }
 228
 229 /*
 230
 231 =item * static void rat_power_int(PARROT_INTERP, PMC *self, int value, PMC *dest)
 232
 233 Calculates the power of a Rational-PMC to an exponent value and stores the result in (another)
 234 Rational-PMC.
 235
 236 =cut
 237
 238 */
 239 static void rat_power_int(PARROT_INTERP, PMC *self, int value, PMC *dest) {
 240   #ifdef PARROT_HAS_GMP
 241     mpz_t t;
 242
 243     if (dest)
 244         VTABLE_morph(interp, dest, self->vtable->base_type);
 245     else
 246         dest = pmc_new(interp, self->vtable->base_type);
 247
 248     mpq_get_num(t, RT(self));
 249     mpz_pow_ui(t, t, (unsigned int) value);
 250     mpq_set_num(RT(dest), t);
 251     mpz_clear(t);
 252
 253     mpq_get_den(t, RT(self));
 254     mpz_pow_ui(t, t, (unsigned int) value);
 255     mpq_set_den(RT(dest), t);
 256     mpz_clear(t);
 257   #else
 258     RAISE_EXCEPTION
 259   #endif
 260 }
 261
 262 /*
 263
 264 =back
 265
 266 =cut
 267
 268 */
 269
 270 pmclass Rational dynpmc provides scalar {
 271 /*
 272
 273 =head2 Methods
 274
 275 The DynPMC Rational has the following methods. Note, that all methods depend on GMP. If GMP is not
 276 available, an exception is thrown in almost all cases. The only exception is the version-method.
 277
 278 =over 4
 279
 280 =item C<METHOD version()>
 281
 282 Returns the version of GNU Multiple Precision library. Returns 0.0.0, if GMP is not available.
 283
 284 =cut
 285
 286 */
 287     METHOD version() {
 288         STRING *version;
 289       #ifdef PARROT_HAS_GMP
 290         version = string_from_cstring(INTERP, gmp_version, 0);
 291       #else
 292         version = string_from_cstring(INTERP, "0.0.0", 0);
 293       #endif
 294         RETURN(STRING *version);
 295     }
 296
 297 /*
 298
 299 =item C<void init()>
 300
 301 =cut
 302
 303 */
 304     VTABLE void init() {
 305       #ifdef PARROT_HAS_GMP
 306         PMC_struct_val(SELF) = malloc(sizeof (RATIONAL));
 307         mpq_init(RT(SELF));
 308         PObj_active_destroy_SET(SELF);
 309       #else
 310         PMC_struct_val(SELF) = NULL;
 311       #endif
 312     }
 313
 314 /*
 315
 316 =item C<void clone()>
 317
 318 =cut
 319
 320 */
 321     VTABLE PMC *clone() {
 322       #ifdef PARROT_HAS_GMP
 323         mpz_t num, den;
 324         PMC *ret = pmc_new(INTERP, SELF->vtable->base_type);
 325         mpq_get_num(num, RT(SELF));
 326         mpq_get_den(den, RT(SELF));
 327         mpq_set_num(RT(ret), num);
 328         mpq_set_den(RT(ret), den);
 329         mpz_clear(num);
 330         mpz_clear(den);
 331         return ret;
 332       #else
 333         RAISE_EXCEPTION
 334       #endif
 335     }
 336
 337 /*
 338
 339 =item C<void destroy()>
 340
 341 =cut
 342
 343 */
 344     VTABLE void destroy() {
 345       #ifdef PARROT_HAS_GMP
 346         mpq_clear(RT(SELF));
 347         mem_sys_free(PMC_struct_val(SELF));
 348       #else
 349         RAISE_EXCEPTION
 350       #endif
 351     }
 352
 353 /*
 354
 355 =item C<void set_integer_native(INTVAL)>
 356
 357 =cut
 358
 359 */
 360     VTABLE void set_integer_native(INTVAL value) {
 361       #ifdef PARROT_HAS_GMP
 362         mpq_set_si(RT(SELF), (signed int) value, 1);
 363         mpq_canonicalize(RT(SELF));
 364       #else
 365         RAISE_EXCEPTION
 366       #endif
 367     }
 368
 369 /*
 370
 371 =item C<void set_number_native(FLOATVAL)>
 372
 373 =cut
 374
 375 */
 376     VTABLE void set_number_native(FLOATVAL value) {
 377       #ifdef PARROT_HAS_GMP
 378         mpq_set_d(RT(SELF), (double) value);
 379         mpq_canonicalize(RT(SELF));
 380       #else
 381         RAISE_EXCEPTION
 382       #endif
 383     }
 384
 385 /*
 386
 387 =item C<void set_string_native(STRING*)>
 388
 389 =cut
 390
 391 */
 392     VTABLE void set_string_native(STRING *value) {
 393       #ifdef PARROT_HAS_GMP
 394         char *cstr = string_to_cstring(INTERP, value);
 395         mpq_set_str(RT(SELF), cstr, 0);
 396         mpq_canonicalize(RT(SELF));
 397         string_cstring_free(cstr);
 398       #else
 399         RAISE_EXCEPTION
 400       #endif
 401     }
 402
 403 /*
 404
 405 =item C<void set_string_keyed_int(INTVAL base, STRING *value)>
 406
 407 =cut
 408
 409 */
 410     VTABLE void set_string_keyed_int(INTVAL base, STRING *value) {
 411       #ifdef PARROT_HAS_GMP
 412         char *cstr = string_to_cstring(INTERP, value);
 413         mpq_set_str(RT(SELF), cstr, (int) base);
 414         mpq_canonicalize(RT(SELF));
 415         string_cstring_free(cstr);
 416       #else
 417         RAISE_EXCEPTION
 418       #endif
 419     }
 420
 421
 422 /*
 423
 424 =item C<INTVAL get_integer()>
 425
 426 =cut
 427
 428 */
 429     VTABLE INTVAL get_integer() {
 430       #ifdef PARROT_HAS_GMP
 431         mpz_t q;
 432         mpz_init(q);
 433         mpz_tdiv_q(q, mpq_numref(RT(SELF)), mpq_denref(RT(SELF)));
 434         if (mpz_fits_slong_p(q)) {
 435             INTVAL ret = (INTVAL) mpz_get_si(q);
 436             mpz_clear(q);
 437             return ret;
 438         }
 439         else {
 440             mpz_clear(q);
 441             Parrot_ex_throw_from_c_args(INTERP, NULL, 1,
 442                 "Rational, get_integer(): Number is too big.");
 443         }
 444       #else
 445         RAISE_EXCEPTION
 446       #endif
 447     }
 448
 449 /*
 450
 451 =item C<get_number()>
 452
 453 =cut
 454
 455 */
 456     VTABLE FLOATVAL get_number() {
 457       #ifdef PARROT_HAS_GMP
 458         double d;
 459         d = mpq_get_d(RT(SELF));
 460         return (FLOATVAL) d;
 461       #else
 462         RAISE_EXCEPTION
 463       #endif
 464     }
 465
 466 /*
 467
 468 =item C<get_bool()>
 469
 470 =cut
 471
 472 */
 473     VTABLE INTVAL get_bool() {
 474       #ifdef PARROT_HAS_GMP
 475         if (mpq_cmp_si(RT(SELF), 0, 0))
 476             return 0;
 477         else
 478             return 1;
 479       #else
 480         RAISE_EXCEPTION
 481       #endif
 482     }
 483 /*
 484
 485 =item C<STRING *get_string()>
 486
 487 =cut
 488
 489 */
 490     VTABLE STRING *get_string() {
 491       #ifdef PARROT_HAS_GMP
 492         return rat_get_string_to_base(INTERP, SELF, 10);
 493       #else
 494         RAISE_EXCEPTION
 495       #endif
 496     }
 497
 498 /*
 499
 500 =item C<STRING *get_string_keyed_int(INTVAL base)>
 501
 502 =cut
 503
 504 */
 505     VTABLE STRING *get_string_keyed_int(INTVAL base) {
 506       #ifdef PARROT_HAS_GMP
 507         return rat_get_string_to_base(INTERP, SELF, (int) base);
 508       #else
 509         RAISE_EXCEPTION
 510       #endif
 511     }
 512
 513 /*
 514
 515 =item C<void increment()>
 516
 517 =cut
 518
 519 */
 520     VTABLE void increment() {
 521       #ifdef PARROT_HAS_GMP
 522         mpz_add(mpq_numref(RT(SELF)), mpq_numref(RT(SELF)), mpq_denref(RT(SELF)));
 523         mpq_canonicalize(RT(SELF));
 524       #else
 525         RAISE_EXCEPTION
 526       #endif
 527     }
 528
 529 /*
 530
 531 =item C<void decrement()>
 532
 533 =cut
 534
 535 */
 536     VTABLE void decrement() {
 537       #ifdef PARROT_HAS_GMP
 538         mpz_sub(mpq_numref(RT(SELF)), mpq_numref(RT(SELF)), mpq_denref(RT(SELF)));
 539         mpq_canonicalize(RT(SELF));
 540       #else
 541         RAISE_EXCEPTION
 542       #endif
 543     }
 544
 545 /*
 546
 547 =item C<PMC *add(PMC* value, PMC* dest)>
 548
 549 Adds Integer-, Float- or Rational-PMCs to SELF and stores them in dest.
 550
 551 =cut
 552
 553 */
 554     VTABLE PMC *add(PMC* value, PMC* dest) {
 555 MMD_Integer: {
 556         rat_add_integer(INTERP, SELF, PMC_int_val(value), dest);
 557         return dest;
 558         }
 559 MMD_Float: {
 560         rat_add_float(INTERP, SELF, PMC_num_val(value), dest);
 561         return dest;
 562         }
 563 MMD_Rational: {
 564       #ifdef PARROT_HAS_GMP
 565         if (dest)
 566             VTABLE_morph(INTERP, dest, SELF->vtable->base_type);
 567         else
 568             dest = pmc_new(INTERP, SELF->vtable->base_type);
 569
 570         mpq_add(RT(dest), RT(SELF), RT(value));
 571         return dest;
 572       #else
 573         RAISE_EXCEPTION
 574       #endif
 575         }
 576 MMD_DEFAULT: {
 577     Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 578         "Rational, add: Not implemented (yet).");
 579         }
 580     }
 581
 582 /*
 583
 584 =item C<void i_add(PMC *value)>
 585
 586 =cut
 587
 588 */
 589     VTABLE void i_add(PMC *value) {
 590 MMD_Integer: {
 591         rat_add_integer(INTERP, SELF, (int) PMC_int_val(value), SELF);
 592         }
 593 MMD_Float: {
 594         rat_add_float(INTERP, SELF, (double) PMC_num_val(value), SELF);
 595         }
 596 MMD_Rational: {
 597       #ifdef PARROT_HAS_GMP
 598         mpq_add(RT(SELF), RT(SELF), RT(value));
 599       #else
 600         RAISE_EXCEPTION
 601       #endif
 602         }
 603 MMD_DEFAULT: {
 604     Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 605         "Rational, i_add: Not implemented (yet).");
 606         }
 607     }
 608
 609 /*
 610
 611 =item C<PMC *add_int(INTVAL value, PMC* dest)>
 612
 613 =cut
 614
 615 */
 616     VTABLE PMC *add_int(INTVAL value, PMC* dest) {
 617         rat_add_integer(INTERP, SELF, (int) value, dest);
 618         return dest;
 619     }
 620
 621 /*
 622
 623 =item C<void i_add_int(INTVAL value)>
 624
 625 =cut
 626
 627 */
 628     VTABLE void i_add_int(INTVAL value) {
 629         rat_add_integer(INTERP, SELF, (int) value, SELF);
 630     }
 631
 632 /*
 633
 634 =item C<PMC *add_float(FLOATVAL value, PMC* dest)>
 635
 636 =cut
 637
 638 */
 639     VTABLE PMC *add_float(FLOATVAL value, PMC* dest) {
 640         rat_add_float(INTERP, SELF, (double) value, dest);
 641         return dest;
 642     }
 643
 644 /*
 645
 646 =item C<void i_add_float(FLOATVAL value)>
 647
 648 =cut
 649
 650 */
 651     VTABLE void i_add_float(FLOATVAL value) {
 652         rat_add_float(INTERP, SELF, (double) value, SELF);
 653     }
 654
 655 /*
 656
 657 =item C<PMC *subtract(PMC* value, PMC* dest)>
 658
 659 =cut
 660
 661 */
 662     VTABLE PMC *subtract(PMC* value, PMC* dest) {
 663 MMD_Integer: {
 664         rat_add_integer(INTERP, SELF, -((int) PMC_int_val(value)), dest);
 665         return dest;
 666         }
 667 MMD_Float: {
 668         rat_add_float(INTERP, SELF, - ((double) PMC_num_val(value)), dest);
 669         return dest;
 670         }
 671 MMD_Rational: {
 672       #ifdef PARROT_HAS_GMP
 673         if (dest)
 674             VTABLE_morph(INTERP, dest, SELF->vtable->base_type);
 675         else
 676             dest = pmc_new(INTERP, SELF->vtable->base_type);
 677
 678         mpq_sub(RT(dest), RT(SELF), RT(value));
 679         return dest;
 680       #else
 681         RAISE_EXCEPTION
 682       #endif
 683         }
 684 MMD_DEFAULT: {
 685     Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 686         "Rational, subtract: Not implemented (yet).");
 687         }
 688     }
 689
 690 /*
 691
 692 =item C<void i_subtract(PMC *value)>
 693
 694 =cut
 695
 696 */
 697     VTABLE void i_subtract(PMC *value) {
 698 MMD_Integer: {
 699         rat_add_integer(INTERP, SELF, -((int) PMC_int_val(value)), SELF);
 700         }
 701 MMD_Float: {
 702         rat_add_float(INTERP, SELF, - ((double) PMC_num_val(value)), SELF);
 703         }
 704 MMD_Rational: {
 705       #ifdef PARROT_HAS_GMP
 706         mpq_sub(RT(SELF), RT(SELF), RT(value));
 707       #else
 708         RAISE_EXCEPTION
 709       #endif
 710         }
 711 MMD_DEFAULT: {
 712     Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 713         "Rational, i_subtract: Not implemented (yet).");
 714         }
 715     }
 716
 717 /*
 718
 719 =item C<PMC *subtract_int(INTVAL value, PMC* dest)>
 720
 721 =cut
 722
 723 */
 724     VTABLE PMC *subtract_int(INTVAL value, PMC* dest) {
 725         rat_add_integer(INTERP, SELF, -((int) value), dest);
 726         return dest;
 727     }
 728
 729 /*
 730
 731 =item C<void i_subtract_int(INTVAL value)>
 732
 733 =cut
 734
 735 */
 736     VTABLE void i_subtract_int(INTVAL value) {
 737         rat_add_integer(INTERP, SELF, -((int) value), SELF);
 738     }
 739
 740 /*
 741
 742 =item C<PMC *subtract_float(FLOATVAL value, PMC* dest)>
 743
 744 =cut
 745
 746 */
 747     VTABLE PMC *subtract_float(FLOATVAL value, PMC* dest) {
 748         rat_add_float(INTERP, SELF, -((double) value), dest);
 749         return dest;
 750     }
 751
 752 /*
 753
 754 =item C<void i_subtract_float(FLOATVAL value)>
 755
 756 =cut
 757
 758 */
 759     VTABLE void i_subtract_float(FLOATVAL value) {
 760         rat_add_float(INTERP, SELF, -((double) value), SELF);
 761     }
 762
 763 /*
 764
 765 =item C<PMC *multiply(PMC* value, PMC* dest)>
 766
 767 =cut
 768
 769 */
 770     VTABLE PMC *multiply(PMC* value, PMC* dest) {
 771 MMD_Integer: {
 772         rat_multiply_integer(INTERP, SELF, (int) PMC_int_val(value), dest);
 773         return dest;
 774         }
 775 MMD_Float: {
 776         rat_multiply_float(INTERP, SELF, (double) PMC_num_val(value), dest);
 777         return dest;
 778         }
 779 MMD_Rational: {
 780       #ifdef PARROT_HAS_GMP
 781         if (dest)
 782             VTABLE_morph(INTERP, dest, SELF->vtable->base_type);
 783         else
 784             dest = pmc_new(INTERP, SELF->vtable->base_type);
 785
 786         mpq_mul(RT(dest), RT(SELF), RT(value));
 787         return dest;
 788       #else
 789         RAISE_EXCEPTION
 790       #endif
 791         }
 792 MMD_DEFAULT: {
 793         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 794             "Rational, multiply: Not implemented (yet).");
 795         }
 796     }
 797
 798 /*
 799
 800 =item C<void i_multiply(PMC *value)>
 801
 802 =cut
 803
 804 */
 805     VTABLE void i_multiply(PMC *value) {
 806 MMD_Integer: {
 807         rat_multiply_integer(INTERP, SELF, (int) PMC_int_val(value), SELF);
 808         }
 809 MMD_Float: {
 810         rat_multiply_float(INTERP, SELF, (double) PMC_num_val(value), SELF);
 811         }
 812 MMD_Rational: {
 813       #ifdef PARROT_HAS_GMP
 814         mpq_mul(RT(SELF), RT(SELF), RT(value));
 815       #else
 816         RAISE_EXCEPTION
 817       #endif
 818         }
 819 MMD_DEFAULT: {
 820         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 821             "Rational, i_multiply: Not implemented (yet).");
 822         }
 823     }
 824
 825 /*
 826
 827 =item C<PMC *multiply_int(INTVAL value, PMC* dest)>
 828
 829 =cut
 830
 831 */
 832     VTABLE PMC *multiply_int(INTVAL value, PMC* dest) {
 833         rat_multiply_integer(INTERP, SELF, (int) value, dest);
 834         return dest;
 835     }
 836
 837 /*
 838
 839 =item C<void i_multiply_int(INTVAL value)>
 840
 841 =cut
 842
 843 */
 844     VTABLE void i_multiply_int(INTVAL value) {
 845         rat_multiply_integer(INTERP, SELF, (int) value, SELF);
 846     }
 847
 848 /*
 849
 850 =item C<PMC *multiply_float(FLOATVAL value, PMC* dest)>
 851
 852 =cut
 853
 854 */
 855     VTABLE PMC *multiply_float(FLOATVAL value, PMC* dest) {
 856         rat_multiply_float(INTERP, SELF, (double) value, dest);
 857         return dest;
 858     }
 859
 860 /*
 861
 862 =item C<void i_multiply_float(FLOATVAL value)>
 863
 864 =cut
 865
 866 */
 867     VTABLE void i_multiply_float(FLOATVAL value) {
 868         rat_multiply_float(INTERP, SELF, (double) value, SELF);
 869     }
 870
 871 /*
 872
 873 =item C<PMC *divide(PMC* value, PMC* dest)>
 874
 875 =cut
 876
 877 */
 878     VTABLE PMC *divide(PMC* value, PMC* dest) {
 879 MMD_Integer: {
 880         rat_divide_integer(INTERP, SELF, (int) PMC_int_val(value), dest);
 881         return dest;
 882         }
 883 MMD_Float: {
 884         rat_divide_float(INTERP, SELF, (double) PMC_num_val(value), dest);
 885         return dest;
 886         }
 887 MMD_Rational: {
 888       #ifdef PARROT_HAS_GMP
 889         if (dest)
 890             VTABLE_morph(INTERP, dest, SELF->vtable->base_type);
 891         else
 892             dest = pmc_new(INTERP, SELF->vtable->base_type);
 893
 894         mpq_div(RT(dest), RT(SELF), RT(value));
 895         return dest;
 896       #else
 897         RAISE_EXCEPTION
 898       #endif
 899         }
 900 MMD_DEFAULT: {
 901         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 902             "Rational, divide: Not implemented (yet).");
 903         }
 904     }
 905
 906 /*
 907
 908 =item C<void i_divide(PMC *value)>
 909
 910 =cut
 911
 912 */
 913     VTABLE void i_divide(PMC *value) {
 914 MMD_Integer: {
 915         rat_divide_integer(INTERP, SELF, (int) PMC_int_val(value), SELF);
 916         }
 917 MMD_Float: {
 918         rat_divide_float(INTERP, SELF, (double) PMC_num_val(value), SELF);
 919         }
 920 MMD_Rational: {
 921       #ifdef PARROT_HAS_GMP
 922         mpq_div(RT(SELF), RT(SELF), RT(value));
 923       #else
 924         RAISE_EXCEPTION
 925       #endif
 926         }
 927 MMD_DEFAULT: {
 928         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
 929             "Rational, i_divide: Not implemented (yet).");
 930         }
 931     }
 932
 933 /*
 934
 935 =item C<PMC *divide_int(INTVAL value, PMC* dest)>
 936
 937 =cut
 938
 939 */
 940     VTABLE PMC *divide_int(INTVAL value, PMC* dest) {
 941         rat_divide_integer(INTERP, SELF, (int) value, dest);
 942         return dest;
 943     }
 944
 945 /*
 946
 947 =item C<void i_divide_int(INTVAL value)>
 948
 949 =cut
 950
 951 */
 952     VTABLE void i_divide_int(INTVAL value) {
 953         rat_divide_integer(INTERP, SELF, (int) value, SELF);
 954     }
 955
 956 /*
 957
 958 =item C<PMC *divide_float(FLOATVAL value, PMC* dest)>
 959
 960 =cut
 961
 962 */
 963     VTABLE PMC *divide_float(FLOATVAL value, PMC* dest) {
 964         rat_divide_float(INTERP, SELF, (double) value, dest);
 965         return dest;
 966     }
 967
 968 /*
 969
 970 =item C<void i_divide_float(FLOATVAL value)>
 971
 972 =cut
 973
 974 */
 975     VTABLE void i_divide_float(FLOATVAL value) {
 976         rat_divide_float(INTERP, SELF, (double) value, SELF);
 977     }
 978
 979 /*
 980
 981 =item C<PMC *negate(PMC* dest)>
 982
 983 =cut
 984
 985 */
 986     VTABLE PMC *neg(PMC* dest) {
 987       #ifdef PARROT_HAS_GMP
 988         if (dest)
 989             VTABLE_morph(INTERP, dest, SELF->vtable->base_type);
 990         else
 991             dest = pmc_new(INTERP, SELF->vtable->base_type);
 992
 993         mpq_neg(RT(dest), RT(SELF));
 994         return dest;
 995       #else
 996         RAISE_EXCEPTION
 997       #endif
 998     }
 999
1000 /*
1001
1002 =item C<void i_negate()>
1003
1004 =cut
1005
1006 */
1007     VTABLE void i_neg() {
1008       #ifdef PARROT_HAS_GMP
1009         mpq_neg(RT(SELF), RT(SELF));
1010       #else
1011         RAISE_EXCEPTION
1012       #endif
1013     }
1014
1015 /*
1016
1017 =item C<PMC *absolute(PMC* dest)>
1018
1019 =cut
1020
1021 */
1022     VTABLE PMC *absolute(PMC* dest) {
1023       #ifdef PARROT_HAS_GMP
1024         if (dest)
1025             VTABLE_morph(INTERP, dest, SELF->vtable->base_type);
1026         else
1027             dest = pmc_new(INTERP, SELF->vtable->base_type);
1028
1029         mpq_abs(RT(dest), RT(SELF));
1030         return dest;
1031       #else
1032         RAISE_EXCEPTION
1033       #endif
1034     }
1035
1036 /*
1037
1038 =item C<void i_absolute()>
1039
1040 =cut
1041
1042 */
1043     VTABLE void i_absolute() {
1044       #ifdef PARROT_HAS_GMP
1045         mpq_abs(RT(SELF), RT(SELF));
1046       #else
1047         RAISE_EXCEPTION
1048       #endif
1049     }
1050
1051 /*
1052
1053 =item C<INTVAL cmp(PMC *value)>
1054
1055 =cut
1056
1057 */
1058     VTABLE INTVAL cmp(PMC *value) {
1059 MMD_Integer: {
1060       #ifdef PARROT_HAS_GMP
1061         return (INTVAL) mpq_cmp_si(RT(SELF), PMC_int_val(value), 1);
1062       #else
1063         RAISE_EXCEPTION
1064       #endif
1065       }
1066 MMD_Float: {
1067       #ifdef PARROT_HAS_GMP
1068         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
1069             "This is going to get implemented soon.");
1070       #else
1071         RAISE_EXCEPTION
1072       #endif
1073       }
1074 MMD_Rational: {
1075       #ifdef PARROT_HAS_GMP
1076         return (INTVAL) mpq_cmp(RT(SELF), RT(value));
1077       #else
1078         RAISE_EXCEPTION
1079       #endif
1080       }
1081 MMD_DEFAULT: {
1082         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
1083             "cmp not implemented (yet).");
1084       }
1085     }
1086
1087 /*
1088
1089 =item C<INTVAL is_equal(PMC *value)>
1090
1091 =cut
1092
1093 */
1094     VTABLE INTVAL is_equal(PMC *value) {
1095 MMD_Integer: {
1096       #ifdef PARROT_HAS_GMP
1097         INTVAL eq = 0;
1098         mpq_t t;
1099         mpq_init(t);
1100         mpq_set_ui(t, PMC_int_val(value), 1);
1101
1102         eq = (INTVAL) mpq_equal(RT(SELF), RT(value));
1103         mpq_clear(t);
1104
1105         return eq;
1106       #else
1107         RAISE_EXCEPTION
1108       #endif
1109       }
1110 MMD_Float: {
1111         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
1112             "Equality to floats can not be checked because of limited machine "
1113             "accuracy.\nApproximate the rational and check whether the "
1114             "difference to a value is lower\nthan an epsilon.");
1115       }
1116 MMD_Rational: {
1117       #ifdef PARROT_HAS_GMP
1118         return (INTVAL) mpq_equal(RT(SELF), RT(value));
1119       #else
1120         RAISE_EXCEPTION
1121       #endif
1122       }
1123 MMD_DEFAULT: {
1124         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_UNIMPLEMENTED,
1125             "is_equal not implemented (yet).");
1126       }
1127     }
1128 }
1129
1130 /*
1131  * Local variables:
1132  *   c-file-style: "parrot"
1133  * End:
1134  * vim: expandtab shiftwidth=4:
1135  */