diff options
author | tadf <tadf@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2008-03-16 00:23:43 +0000 |
---|---|---|
committer | tadf <tadf@b2dd03c8-39d4-4d8f-98ff-823fe69b080e> | 2008-03-16 00:23:43 +0000 |
commit | 6125552c27b40a8da9e162af2655feca82ac16d3 (patch) | |
tree | 8f77bc1b34603f4ce939aa4b5a77f5e8303b7df4 /rational.c | |
parent | 2694b2f937681526550b8aabf798f033fa557049 (diff) |
both complex and rational are now builtin classes.
git-svn-id: svn+ssh://ci.ruby-lang.org/ruby/trunk@15783 b2dd03c8-39d4-4d8f-98ff-823fe69b080e
Diffstat (limited to 'rational.c')
-rw-r--r-- | rational.c | 1111 |
1 files changed, 1111 insertions, 0 deletions
diff --git a/rational.c b/rational.c new file mode 100644 index 0000000000..ba8583b310 --- /dev/null +++ b/rational.c @@ -0,0 +1,1111 @@ +/* + nurat_core.c: Coded by Tadayoshi Funaba 2008 + + This implementation is based on Keiju Ishitsuka's Rational library + which is written in ruby. +*/ + +#include "ruby.h" +#include <math.h> + +#define NDEBUG +#include <assert.h> + +#ifndef RATIONAL_NAME +#define RATIONAL_NAME "Rational" +#endif + +#define ZERO INT2FIX(0) +#define ONE INT2FIX(1) +#define TWO INT2FIX(2) + +VALUE rb_cRational; + +static ID id_Unify, id_cmp, id_coerce, id_convert, id_equal_p, id_expt, + id_floor, id_format,id_idiv, id_inspect, id_negate, id_new, id_new_bang, + id_to_f, id_to_i, id_to_s, id_truncate; + +#define f_add(x,y) rb_funcall(x, '+', 1, y) +#define f_div(x,y) rb_funcall(x, '/', 1, y) +#define f_gt_p(x,y) rb_funcall(x, '>', 1, y) +#define f_lt_p(x,y) rb_funcall(x, '<', 1, y) +#define f_mod(x,y) rb_funcall(x, '%', 1, y) +#define f_mul(x,y) rb_funcall(x, '*', 1, y) +#define f_sub(x,y) rb_funcall(x, '-', 1, y) +#define f_xor(x,y) rb_funcall(x, '^', 1, y) + +#define f_floor(x) rb_funcall(x, id_floor, 0) +#define f_inspect(x) rb_funcall(x, id_inspect, 0) +#define f_to_f(x) rb_funcall(x, id_to_f, 0) +#define f_to_i(x) rb_funcall(x, id_to_i, 0) +#define f_to_s(x) rb_funcall(x, id_to_s, 0) +#define f_truncate(x) rb_funcall(x, id_truncate, 0) +#define f_cmp(x,y) rb_funcall(x, id_cmp, 1, y) +#define f_coerce(x,y) rb_funcall(x, id_coerce, 1, y) +#define f_equal_p(x,y) rb_funcall(x, id_equal_p, 1, y) +#define f_expt(x,y) rb_funcall(x, id_expt, 1, y) +#define f_idiv(x,y) rb_funcall(x, id_idiv, 1, y) +#define f_negate(x) rb_funcall(x, id_negate, 0) + +#define f_negative_p(x) f_lt_p(x, ZERO) +#define f_zero_p(x) f_equal_p(x, ZERO) +#define f_one_p(x) f_equal_p(x, ONE) +#define f_kind_of_p(x,c) rb_obj_is_kind_of(x, c) +#define k_numeric_p(x) f_kind_of_p(x, rb_cNumeric) +#define k_integer_p(x) f_kind_of_p(x, rb_cInteger) +#define k_float_p(x) f_kind_of_p(x, rb_cFloat) +#define k_rational_p(x) f_kind_of_p(x, rb_cRational) + +#define f_boolcast(x) ((x) ? Qtrue : Qfalse) + +inline static long +i_gcd(long x, long y) +{ + long b; + + if (x < 0) + x = -x; + if (y < 0) + y = -y; + + if (x == 0) + return y; + if (y == 0) + return x; + + b = 0; + while ((x & 1) == 0 && (y & 1) == 0) { + b += 1; + x >>= 1; + y >>= 1; + } + + while ((x & 1) == 0) + x >>= 1; + + while ((y & 1) == 0) + y >>= 1; + + while (x != y) { + if (y > x) { + long t; + t = x; + x = y; + y = t; + } + x -= y; + while ((x & 1) == 0) + x >>= 1; + } + + return x << b; +} + +inline static VALUE +f_gcd(VALUE x, VALUE y) +{ + VALUE z; + + if (FIXNUM_P(x) && FIXNUM_P(y)) + return LONG2NUM(i_gcd(FIX2LONG(x), FIX2LONG(y))); + + if (f_negative_p(x)) + x = f_negate(x); + if (f_negative_p(y)) + y = f_negate(y); + + if (f_zero_p(x)) + return y; + if (f_zero_p(y)) + return x; + + for (;;) { + if (FIXNUM_P(x)) { + if (FIX2INT(x) == 0) + return y; + if (FIXNUM_P(y)) + return LONG2NUM(i_gcd(FIX2LONG(x), FIX2LONG(y))); + } + z = x; + x = f_mod(y, x); + y = z; + } + /* NOTREACHED */ +} + +#define get_dat1(x) \ + struct RRational *dat;\ + dat = ((struct RRational *)(x)) + +#define get_dat2(x,y) \ + struct RRational *adat, *bdat;\ + adat = ((struct RRational *)(x));\ + bdat = ((struct RRational *)(y)) + +inline static VALUE +nurat_s_new_internal(VALUE klass, VALUE num, VALUE den) +{ + NEWOBJ(obj, struct RRational); + OBJSETUP(obj, klass, T_RATIONAL); + + obj->num = num; + obj->den = den; + + return (VALUE)obj; +} + +static VALUE +nurat_s_alloc(VALUE klass) +{ + return nurat_s_new_internal(klass, ZERO, ONE); +} + +static VALUE +nurat_s_new_bang(int argc, VALUE *argv, VALUE klass) +{ + VALUE num, den; + + switch (rb_scan_args(argc, argv, "11", &num, &den)) { + case 1: + if (!k_integer_p(num)) + num = f_to_i(num); + den = ONE; + break; + default: + if (!k_integer_p(num)) + num = f_to_i(num); + if (!k_integer_p(den)) + den = f_to_i(den); + + if (f_negative_p(den)) { + num = f_negate(num); + den = f_negate(den); + } + break; + } + + return nurat_s_new_internal(klass, num, den); +} + +inline static VALUE +f_rational_new_bang1(VALUE klass, VALUE x) +{ + return nurat_s_new_internal(klass, x, ONE); +} + +inline static VALUE +f_rational_new_bang2(VALUE klass, VALUE x, VALUE y) +{ + assert(!f_negative_p(y)); + assert(!f_zero_p(y)); + return nurat_s_new_internal(klass, x, y); +} + +#define f_unify_p(klass) rb_const_defined(klass, id_Unify) + +inline static VALUE +nurat_s_canonicalize_internal(VALUE klass, VALUE num, VALUE den) +{ + VALUE gcd; + + switch (FIX2INT(f_cmp(den, ZERO))) { + case -1: + if (f_negative_p(den)) { + num = f_negate(num); + den = f_negate(den); + } + break; + case 0: + rb_raise(rb_eZeroDivError, "devided by zero"); + break; + } + + gcd = f_gcd(num, den); + num = f_idiv(num, gcd); + den = f_idiv(den, gcd); + + if (f_one_p(den) && f_unify_p(klass)) + return num; + else + return nurat_s_new_internal(klass, num, den); +} + +static VALUE +nurat_s_canonicalize(int argc, VALUE *argv, VALUE klass) +{ + VALUE num, den; + + switch (rb_scan_args(argc, argv, "11", &num, &den)) { + case 1: + den = ONE; + break; + } + + switch (TYPE(num)) { + case T_FIXNUM: + case T_BIGNUM: + break; + default: + rb_raise(rb_eArgError, "not an integer"); + } + + switch (TYPE(den)) { + case T_FIXNUM: + case T_BIGNUM: + break; + default: + rb_raise(rb_eArgError, "not an integer"); + } + + return nurat_s_canonicalize_internal(klass, num, den); +} + +static VALUE +nurat_s_new(int argc, VALUE *argv, VALUE klass) +{ + VALUE num, den; + + switch (rb_scan_args(argc, argv, "11", &num, &den)) { + case 1: + den = ONE; + break; + } + + switch (TYPE(num)) { + case T_FIXNUM: + case T_BIGNUM: + break; + default: + rb_raise(rb_eArgError, "not an integer"); + } + + switch (TYPE(den)) { + case T_FIXNUM: + case T_BIGNUM: + break; + default: + rb_raise(rb_eArgError, "not an integer"); + } + + return nurat_s_canonicalize_internal(klass, num, den); +} + +inline static VALUE +f_rational_new1(VALUE klass, VALUE x) +{ + assert(!k_rational_p(x)); + return nurat_s_canonicalize_internal(klass, x, ONE); +} + +inline static VALUE +f_rational_new2(VALUE klass, VALUE x, VALUE y) +{ + assert(!k_rational_p(x)); + assert(!k_rational_p(y)); + return nurat_s_canonicalize_internal(klass, x, y); +} + +static VALUE +nurat_f_rational(int argc, VALUE *argv, VALUE klass) +{ + return rb_funcall2(rb_cRational, id_convert, argc, argv); +} + +static VALUE +nurat_numerator(VALUE self) +{ + get_dat1(self); + return dat->num; +} + +static VALUE +nurat_denominator(VALUE self) +{ + get_dat1(self); + return dat->den; +} + +static VALUE +nurat_add(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + return f_add(self, f_rational_new_bang1(CLASS_OF(self), other)); + case T_FLOAT: + return f_add(f_to_f(self), other); + case T_RATIONAL: + { + VALUE num1, num2; + + get_dat2(self, other); + + num1 = f_mul(adat->num, bdat->den); + num2 = f_mul(bdat->num, adat->den); + + return f_rational_new2(CLASS_OF(self), + f_add(num1, num2), + f_mul(adat->den, bdat->den)); + } + default: + { + VALUE a = f_coerce(other, self); + return f_add(RARRAY_PTR(a)[0], RARRAY_PTR(a)[1]); + } + } +} + +static VALUE +nurat_sub(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + return f_sub(self, f_rational_new_bang1(CLASS_OF(self), other)); + case T_FLOAT: + return f_sub(f_to_f(self), other); + case T_RATIONAL: + { + VALUE num1, num2; + + get_dat2(self, other); + + num1 = f_mul(adat->num, bdat->den); + num2 = f_mul(bdat->num, adat->den); + + return f_rational_new2(CLASS_OF(self), + f_sub(num1, num2), + f_mul(adat->den, bdat->den)); + } + default: + { + VALUE a = f_coerce(other, self); + return f_sub(RARRAY_PTR(a)[0], RARRAY_PTR(a)[1]); + } + } +} + +static VALUE +nurat_mul(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + return f_mul(self, f_rational_new_bang1(CLASS_OF(self), other)); + case T_FLOAT: + return f_mul(f_to_f(self), other); + case T_RATIONAL: + { + VALUE num, den; + + get_dat2(self, other); + + num = f_mul(adat->num, bdat->num); + den = f_mul(adat->den, bdat->den); + + return f_rational_new2(CLASS_OF(self), num, den); + } + default: + { + VALUE a = f_coerce(other, self); + return f_mul(RARRAY_PTR(a)[0], RARRAY_PTR(a)[1]); + } + } +} + +static VALUE +nurat_div(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + if (f_zero_p(other)) + rb_raise(rb_eZeroDivError, "devided by zero"); + return f_div(self, f_rational_new_bang1(CLASS_OF(self), other)); + case T_FLOAT: + return f_div(f_to_f(self), other); + case T_RATIONAL: + { + VALUE num, den; + + get_dat2(self, other); + + num = f_mul(adat->num, bdat->den); + den = f_mul(adat->den, bdat->num); + + return f_rational_new2(CLASS_OF(self), num, den); + } + default: + { + VALUE a = f_coerce(other, self); + return f_div(RARRAY_PTR(a)[0], RARRAY_PTR(a)[1]); + } + } +} + +static VALUE +nurat_fdiv(VALUE self, VALUE other) +{ + return f_div(f_to_f(self), other); +} + +static VALUE +nurat_expt(VALUE self, VALUE other) +{ + if (f_zero_p(other)) + return f_rational_new_bang1(CLASS_OF(self), ONE); + + if (k_rational_p(other)) { + get_dat1(other); + + if (f_one_p(dat->den)) + other = dat->num; /* good? */ + } + + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + { + VALUE num, den; + + get_dat1(self); + + switch (FIX2INT(f_cmp(other, ZERO))) { + case 1: + num = f_expt(dat->num, other); + den = f_expt(dat->den, other); + break; + case -1: + num = f_expt(dat->den, f_negate(other)); + den = f_expt(dat->num, f_negate(other)); + break; + default: + num = ONE; + den = ONE; + break; + } + if (f_negative_p(den)) { /* or use normal new */ + num = f_negate(num); + den = f_negate(den); + } + return f_rational_new_bang2(CLASS_OF(self), num, den); + } + case T_FLOAT: + case T_RATIONAL: + return f_expt(f_to_f(self), other); + default: + { + VALUE a = f_coerce(other, self); + return f_expt(RARRAY_PTR(a)[0], RARRAY_PTR(a)[1]); + } + } +} + +static VALUE +nurat_cmp(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + return f_cmp(self, f_rational_new_bang1(CLASS_OF(self), other)); + case T_FLOAT: + return f_cmp(f_to_f(self), other); + case T_RATIONAL: + { + VALUE num1, num2; + + get_dat2(self, other); + + num1 = f_mul(adat->num, bdat->den); + num2 = f_mul(bdat->num, adat->den); + return f_cmp(f_sub(num1, num2), ZERO); + } + default: + { + VALUE a = f_coerce(other, self); + return f_cmp(RARRAY_PTR(a)[0], RARRAY_PTR(a)[1]); + } + } +} + +static VALUE +nurat_equal_p(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + return f_equal_p(self, f_rational_new_bang1(CLASS_OF(self), other)); + case T_FLOAT: + return f_equal_p(f_to_f(self), other); + case T_RATIONAL: + { + get_dat2(self, other); + + return f_boolcast(f_equal_p(adat->num, bdat->num) && + f_equal_p(adat->den, bdat->den)); + } + default: + return f_equal_p(other, self); + } +} + +static VALUE +nurat_coerce(VALUE self, VALUE other) +{ + switch (TYPE(other)) { + case T_FIXNUM: + case T_BIGNUM: + return rb_assoc_new(f_rational_new_bang1(CLASS_OF(self), other), self); + case T_FLOAT: + return rb_assoc_new(other, f_to_f(self)); + } + + rb_raise(rb_eTypeError, "%s can't be coerced into %s", + rb_obj_classname(other), rb_obj_classname(self)); + return Qnil; +} + +static VALUE +nurat_idiv(VALUE self, VALUE other) +{ + return f_floor(f_div(self, other)); +} +static VALUE +nurat_mod(VALUE self, VALUE other) +{ + VALUE val = f_floor(f_div(self, other)); + return f_sub(self, f_mul(other, val)); +} + +static VALUE +nurat_divmod(VALUE self, VALUE other) +{ + VALUE val = f_floor(f_div(self, other)); + return rb_assoc_new(val, f_sub(self, f_mul(other, val))); +} + +static VALUE +nurat_quot(VALUE self, VALUE other) +{ + return f_truncate(f_div(self, other)); +} +static VALUE +nurat_rem(VALUE self, VALUE other) +{ + VALUE val = f_truncate(f_div(self, other)); + return f_sub(self, f_mul(other, val)); +} + +static VALUE +nurat_quotrem(VALUE self, VALUE other) +{ + VALUE val = f_truncate(f_div(self, other)); + return rb_assoc_new(val, f_sub(self, f_mul(other, val))); +} + +static VALUE +nurat_abs(VALUE self) +{ + if (!f_negative_p(self)) + return self; + else + return f_negate(self); +} + +static VALUE +nurat_true(VALUE self) +{ + return Qtrue; +} + +static VALUE +nurat_floor(VALUE self) +{ + get_dat1(self); + return f_idiv(dat->num, dat->den); +} + +static VALUE +nurat_ceil(VALUE self) +{ + get_dat1(self); + return f_negate(f_idiv(f_negate(dat->num), dat->den)); +} + +static VALUE +nurat_truncate(VALUE self) +{ + get_dat1(self); + if (f_negative_p(dat->num)) + return f_negate(f_idiv(f_negate(dat->num), dat->den)); + return f_idiv(dat->num, dat->den); +} + +static VALUE +nurat_round(VALUE self) +{ + get_dat1(self); + + if (f_negative_p(dat->num)) { + VALUE num, den; + + num = f_negate(dat->num); + num = f_add(f_mul(num, TWO), dat->den); + den = f_mul(dat->den, TWO); + return f_negate(f_idiv(num, den)); + } else { + VALUE num = f_add(f_mul(dat->num, TWO), dat->den); + VALUE den = f_mul(dat->den, TWO); + return f_idiv(num, den); + } +} + +static VALUE +nurat_to_f(VALUE self) +{ + get_dat1(self); + return f_div(f_to_f(dat->num), dat->den); /* enough? */ +} + +static VALUE +nurat_to_r(VALUE self) +{ + return self; +} + +static VALUE +nurat_hash(VALUE self) +{ + get_dat1(self); + return f_xor(dat->num, dat->den); +} + +static VALUE +nurat_to_s(VALUE self) +{ + get_dat1(self); + + if (f_one_p(dat->den)) + return f_to_s(dat->num); + else + return rb_funcall(rb_mKernel, id_format, 3, + rb_str_new2("%d/%d"), dat->num, dat->den); +} + +static VALUE +nurat_inspect(VALUE self) +{ + get_dat1(self); + return rb_funcall(rb_mKernel, id_format, 3, + rb_str_new2("Rational(%d, %d)"), dat->num, dat->den); +} + +static VALUE +nurat_marshal_dump(VALUE self) +{ + get_dat1(self); + return rb_assoc_new(dat->num, dat->den); +} + +static VALUE +nurat_marshal_load(VALUE self, VALUE a) +{ + get_dat1(self); + dat->num = RARRAY_PTR(a)[0]; + dat->den = RARRAY_PTR(a)[1]; + return self; +} + +/* --- */ + +VALUE +rb_rational_raw(VALUE x, VALUE y) +{ + return nurat_s_new_internal(rb_cRational, x, y); +} + +VALUE +rb_rational_new(VALUE x, VALUE y) +{ + return nurat_s_canonicalize_internal(rb_cRational, x, y); +} + +static VALUE nurat_s_convert(int argc, VALUE *argv, VALUE klass); + +VALUE +rb_Rational(VALUE x, VALUE y) +{ + VALUE a[2]; + a[0] = x; + a[1] = y; + return nurat_s_convert(2, a, rb_cRational); +} + +static VALUE +nilclass_to_r(VALUE self) +{ + return rb_rational_new1(INT2FIX(0)); +} + +static VALUE +integer_to_r(VALUE self) +{ + return rb_rational_new1(self); +} + +#include <float.h> + +static VALUE +float_decode(VALUE self) +{ + double f; + int n; + + f = frexp(RFLOAT_VALUE(self), &n); + f = ldexp(f, DBL_MANT_DIG); + n -= DBL_MANT_DIG; + return rb_assoc_new(f_to_i(rb_float_new(f)), INT2FIX(n)); +} + +static VALUE +float_to_r(VALUE self) +{ + VALUE a = float_decode(self); + return f_mul(RARRAY_PTR(a)[0], f_expt(INT2FIX(FLT_RADIX), RARRAY_PTR(a)[1])); +} + +static VALUE rat_pat, an_e_pat, a_dot_pat, underscores_pat, an_underscore; + +#define DIGITS "(?:\\d(?:_\\d|\\d)*)" +#define NUMERATOR "(?:" DIGITS "?\\.)?" DIGITS "(?:[eE][-+]?" DIGITS ")?" +#define DENOMINATOR "[-+]?" DIGITS +#define PATTERN "\\A([-+])?(" NUMERATOR ")(?:\\/(" DENOMINATOR "))?" + +static void +make_patterns(void) +{ + static char *rat_pat_source = PATTERN; + static char *an_e_pat_source = "[eE]"; + static char *a_dot_pat_source = "\\."; + static char *underscores_pat_source = "_+"; + + rat_pat = rb_reg_new(rat_pat_source, strlen(rat_pat_source), 0); + rb_global_variable(&rat_pat); + + an_e_pat = rb_reg_new(an_e_pat_source, strlen(an_e_pat_source), 0); + rb_global_variable(&an_e_pat); + + a_dot_pat = rb_reg_new(a_dot_pat_source, strlen(a_dot_pat_source), 0); + rb_global_variable(&a_dot_pat); + + underscores_pat = rb_reg_new(underscores_pat_source, + strlen(underscores_pat_source), 0); + rb_global_variable(&underscores_pat); + + an_underscore = rb_str_new2("_"); + rb_global_variable(&an_underscore); +} + +#define id_strip rb_intern("strip") +#define f_strip(x) rb_funcall(x, id_strip, 0) + +#define id_match rb_intern("match") +#define f_match(x,y) rb_funcall(x, id_match, 1, y) + +#define id_aref rb_intern("[]") +#define f_aref(x,y) rb_funcall(x, id_aref, 1, y) + +#define id_post_match rb_intern("post_match") +#define f_post_match(x) rb_funcall(x, id_post_match, 0) + +#define id_split rb_intern("split") +#define f_split(x,y) rb_funcall(x, id_split, 1, y) + +#include <ctype.h> + +static VALUE +string_to_r_internal(VALUE self) +{ + VALUE s, m; + + s = f_strip(self); + + if (RSTRING_LEN(s) == 0) + return rb_assoc_new(Qnil, self); + + m = f_match(rat_pat, s); + + if (!NIL_P(m)) { + VALUE v, ifp, exp, ip, fp; + VALUE si = f_aref(m, INT2FIX(1)); + VALUE nu = f_aref(m, INT2FIX(2)); + VALUE de = f_aref(m, INT2FIX(3)); + VALUE re = f_post_match(m); + + { + VALUE a; + + a = f_split(nu, an_e_pat); + ifp = RARRAY_PTR(a)[0]; + if (RARRAY_LEN(a) != 2) + exp = Qnil; + else + exp = RARRAY_PTR(a)[1]; + + a = f_split(ifp, a_dot_pat); + ip = RARRAY_PTR(a)[0]; + if (RARRAY_LEN(a) != 2) + fp = Qnil; + else + fp = RARRAY_PTR(a)[1]; + } + + v = rb_rational_new1(f_to_i(ip)); + + if (!NIL_P(fp)) { + char *p = StringValuePtr(fp); + long count = 0; + VALUE l; + + while (*p) { + if (isdigit(*p)) + count++; + p++; + } + + l = f_expt(INT2FIX(10), LONG2NUM(count)); + v = f_mul(v, l); + v = f_add(v, f_to_i(fp)); + v = f_div(v, l); + } + if (!NIL_P(exp)) + v = f_mul(v, f_expt(INT2FIX(10), f_to_i(exp))); + if (!NIL_P(si) && *StringValuePtr(si) == '-') + v = f_negate(v); + if (!NIL_P(de)) + v = f_div(v, f_to_i(de)); + + return rb_assoc_new(v, re); + } + return rb_assoc_new(Qnil, self); +} + +static VALUE +string_to_r_strict(VALUE self) +{ + VALUE a = string_to_r_internal(self); + if (NIL_P(RARRAY_PTR(a)[0]) || RSTRING_LEN(RARRAY_PTR(a)[1]) > 0) { + VALUE s = f_inspect(self); + rb_raise(rb_eArgError, "invalid value for Rational: %s", + StringValuePtr(s)); + } + return RARRAY_PTR(a)[0]; +} + +#define id_gsub rb_intern("gsub") +#define f_gsub(x,y,z) rb_funcall(x, id_gsub, 2, y, z) + +static VALUE +string_to_r(VALUE self) +{ + VALUE s = f_gsub(self, underscores_pat, an_underscore); + VALUE a = string_to_r_internal(s); + if (!NIL_P(RARRAY_PTR(a)[0])) + return RARRAY_PTR(a)[0]; + return rb_rational_new1(INT2FIX(0)); +} + +#define id_to_r rb_intern("to_r") +#define f_to_r(x) rb_funcall(x, id_to_r, 0) + +static VALUE +nurat_s_convert(int argc, VALUE *argv, VALUE klass) +{ + VALUE a1, a2; + + a1 = Qnil; + a2 = Qnil; + rb_scan_args(argc, argv, "02", &a1, &a2); + + switch (TYPE(a1)) { + case T_COMPLEX: + if (k_float_p(RCOMPLEX(a1)->image) || !f_zero_p(RCOMPLEX(a1)->image)) { + VALUE s = f_to_s(a1); + rb_raise(rb_eRangeError, "can't accept %s", + StringValuePtr(s)); + } + a1 = RCOMPLEX(a1)->real; + } + + switch (TYPE(a2)) { + case T_COMPLEX: + if (k_float_p(RCOMPLEX(a2)->image) || !f_zero_p(RCOMPLEX(a2)->image)) { + VALUE s = f_to_s(a2); + rb_raise(rb_eRangeError, "can't accept %s", + StringValuePtr(s)); + } + a2 = RCOMPLEX(a2)->real; + } + + switch (TYPE(a1)) { + case T_FIXNUM: + case T_BIGNUM: + break; + case T_FLOAT: + a1 = f_to_r(a1); + break; + case T_STRING: + a1 = string_to_r_strict(a1); + break; + } + + switch (TYPE(a2)) { + case T_FIXNUM: + case T_BIGNUM: + break; + case T_FLOAT: + a2 = f_to_r(a2); + break; + case T_STRING: + a2 = string_to_r_strict(a2); + break; + } + + switch (TYPE(a1)) { + case T_RATIONAL: + if (NIL_P(a2) || f_zero_p(a2)) + return a1; + else + return f_div(a1, a2); + } + + switch (TYPE(a2)) { + case T_RATIONAL: + return f_div(a1, a2); + } + + { + VALUE argv2[2]; + argv2[0] = a1; + argv2[1] = a2; + return nurat_s_new(argc, argv2, klass); + } +} + +static VALUE +nurat_s_induced_from(VALUE klass, VALUE n) +{ + return f_to_r(n); +} + +void +Init_Rational(void) +{ + assert(fprintf(stderr, "assert() is now active\n")); + + id_Unify = rb_intern("Unify"); + id_cmp = rb_intern("<=>"); + id_coerce = rb_intern("coerce"); + id_convert = rb_intern("convert"); + id_equal_p = rb_intern("=="); + id_expt = rb_intern("**"); + id_floor = rb_intern("floor"); + id_format = rb_intern("format"); + id_idiv = rb_intern("div"); + id_inspect = rb_intern("inspect"); + id_negate = rb_intern("-@"); + id_new = rb_intern("new"); + id_new_bang = rb_intern("new!"); + id_to_f = rb_intern("to_f"); + id_to_i = rb_intern("to_i"); + id_to_s = rb_intern("to_s"); + id_truncate = rb_intern("truncate"); + + rb_cRational = rb_define_class(RATIONAL_NAME, rb_cNumeric); + + rb_define_alloc_func(rb_cRational, nurat_s_alloc); + rb_funcall(rb_cRational, rb_intern("private_class_method"), 1, + ID2SYM(rb_intern("allocate"))); + + rb_define_singleton_method(rb_cRational, "new!", nurat_s_new_bang, -1); + rb_funcall(rb_cRational, rb_intern("private_class_method"), 1, + ID2SYM(rb_intern("new!"))); + + rb_define_singleton_method(rb_cRational, "new", nurat_s_new, -1); + rb_funcall(rb_cRational, rb_intern("private_class_method"), 1, + ID2SYM(rb_intern("new"))); + + rb_define_global_function(RATIONAL_NAME, nurat_f_rational, -1); + + rb_define_method(rb_cRational, "numerator", nurat_numerator, 0); + rb_define_method(rb_cRational, "denominator", nurat_denominator, 0); + + rb_define_method(rb_cRational, "+", nurat_add, 1); + rb_define_method(rb_cRational, "-", nurat_sub, 1); + rb_define_method(rb_cRational, "*", nurat_mul, 1); + rb_define_method(rb_cRational, "/", nurat_div, 1); + rb_define_method(rb_cRational, "fdiv", nurat_fdiv, 1); + rb_define_method(rb_cRational, "**", nurat_expt, 1); + + rb_define_method(rb_cRational, "<=>", nurat_cmp, 1); + rb_define_method(rb_cRational, "==", nurat_equal_p, 1); + rb_define_method(rb_cRational, "coerce", nurat_coerce, 1); + + rb_define_method(rb_cRational, "div", nurat_idiv, 1); +#if NUBY + rb_define_method(rb_cRational, "//", nurat_idiv, 1); +#endif + rb_define_method(rb_cRational, "modulo", nurat_mod, 1); + rb_define_method(rb_cRational, "%", nurat_mod, 1); + rb_define_method(rb_cRational, "divmod", nurat_divmod, 1); + +#if 0 + rb_define_method(rb_cRational, "quot", nurat_quot, 1); +#endif + rb_define_method(rb_cRational, "remainder", nurat_rem, 1); +#if 0 + rb_define_method(rb_cRational, "quotrem", nurat_quotrem, 1); +#endif + + rb_define_method(rb_cRational, "abs", nurat_abs, 0); + +#if 0 + rb_define_method(rb_cRational, "rational?", nurat_true, 0); + rb_define_method(rb_cRational, "exact?", nurat_true, 0); +#endif + + rb_define_method(rb_cRational, "floor", nurat_floor, 0); + rb_define_method(rb_cRational, "ceil", nurat_ceil, 0); + rb_define_method(rb_cRational, "truncate", nurat_truncate, 0); + rb_define_method(rb_cRational, "round", nurat_round, 0); + + rb_define_method(rb_cRational, "to_i", nurat_truncate, 0); + rb_define_method(rb_cRational, "to_f", nurat_to_f, 0); + rb_define_method(rb_cRational, "to_r", nurat_to_r, 0); + + rb_define_method(rb_cRational, "hash", nurat_hash, 0); + + rb_define_method(rb_cRational, "to_s", nurat_to_s, 0); + rb_define_method(rb_cRational, "inspect", nurat_inspect, 0); + + rb_define_method(rb_cRational, "marshal_dump", nurat_marshal_dump, 0); + rb_define_method(rb_cRational, "marshal_load", nurat_marshal_load, 1); + + /* --- */ + + rb_define_method(rb_cNilClass, "to_r", nilclass_to_r, 0); + rb_define_method(rb_cInteger, "to_r", integer_to_r, 0); + rb_define_method(rb_cFloat, "to_r", float_to_r, 0); + + make_patterns(); + + rb_define_method(rb_cString, "to_r", string_to_r, 0); + + rb_define_singleton_method(rb_cRational, "convert", nurat_s_convert, -1); + rb_funcall(rb_cRational, rb_intern("private_class_method"), 1, + ID2SYM(rb_intern("convert"))); + + rb_include_module(rb_cRational, rb_mPrecision); + rb_define_singleton_method(rb_cRational, "induced_from", + nurat_s_induced_from, 1); +} |