cons_t* proc_mul(cons_t *p, environment_t *env) { rational_t product; product.numerator = 1; product.denominator = 1; bool exact = true; for ( ; !nullp(p); p = cdr(p) ) { cons_t *i = listp(p)? car(p) : p; if ( integerp(i) ) { product *= i->number.integer; if ( !i->number.exact ) exact = false; } else if ( rationalp(i) ) { if ( !i->number.exact ) exact = false; product *= i->number.rational; } else if ( realp(i) ) { // automatically convert; perform rest of computation in floats exact = false; return proc_mulf(cons(real(product), p), env); } else raise(runtime_exception("Cannot multiply integer with " + to_s(type_of(i)) + ": " + sprint(i))); } return rational(product, exact); }
/* * Returns a void pointer to the data the cell holds, * whose data type must be compatible with `type`. */ static void* make_arg(ffi_type *type, cons_t* val) { if ( type == &ffi_type_uint || type == &ffi_type_sint ) { if ( !integerp(val) ) raise(runtime_exception("Argument must be an integer")); return static_cast<void*>(&val->number.integer); } if ( type == &ffi_type_pointer ) { if ( stringp(val) ) return static_cast<void*>(&val->string); if ( pointerp(val) ) return &val->pointer->value; if ( integerp(val) ) return &val->number.integer; if ( realp(val) ) return &val->number.real; raise(runtime_exception(format( "Unsupported pointer type %s", to_s(type_of(val)).c_str()))); } const std::string expect = ffi_type_name(type), given = to_s(type_of(val)); raise(runtime_exception(format( "Foreign function wants %s but input data was %s, " "which we don't know how to convert.", indef_art("'"+expect+"'").c_str(), indef_art("'"+given+"'").c_str()))); return NULL; }
cons_t* proc_add(cons_t *p, environment_t* env) { /* * Integers have an IDENTITY, so we can do this, * but a more correct approach would be to take * the value of the FIRST number we find and * return that. */ rational_t sum; sum.numerator = 0; sum.denominator = 1; bool exact = true; for ( ; !nullp(p); p = cdr(p) ) { cons_t *i = listp(p)? car(p) : p; if ( integerp(i) ) { if ( !i->number.exact ) exact = false; sum += i->number.integer; } else if ( rationalp(i) ) { if ( !i->number.exact ) exact = false; sum += i->number.rational; } else if ( realp(i) ) { // automatically convert; perform rest of computation in floats exact = false; return proc_addf(cons(real(sum), p), env); } else raise(runtime_exception( "Cannot add integer with " + to_s(type_of(i)) + ": " + sprint(i))); } return rational(sum, exact); }
cons_t* proc_nanp(cons_t* p, environment_t*) { assert_length(p, 1); assert_number(car(p)); if ( realp(car(p)) ) return boolean(std::isnan(car(p)->number.real)); return boolean(false); }
cons_t* proc_abs(cons_t* p, environment_t*) { assert_length(p, 1); assert_number(car(p)); if ( realp(car(p)) ) { real_t n = car(p)->number.real; return real(n<0.0? -n : n); } int n = car(p)->number.integer; return integer(n<0? -n : n); }
static VOID make_number P2C(Number *, num, LVAL, x) { if (realp(x)) { num->real = makefloat(x); num->imag = 0.0; num->complex = FALSE; } else if (complexp(x)) { num->real = makefloat(getreal(x)); num->imag = makefloat(getimag(x)); num->complex = TRUE; } else xlerror("not a number", x); }
cons_t* proc_mulf(cons_t *p, environment_t*) { real_t product = 1.0; for ( ; !nullp(p); p = cdr(p) ) { cons_t *i = listp(p)? car(p) : p; if ( integerp(i) ) product *= static_cast<real_t>(i->number.integer); else if ( realp(i) ) // automatically convert; perform rest of computation in floats product *= i->number.real; else raise(runtime_exception("Cannot multiply integer with " + to_s(type_of(i)) + ": " + sprint(i))); } return real(product); }
cons_t* proc_addf(cons_t *p, environment_t*) { real_t sum = 0.0; for ( ; !nullp(p); p = cdr(p) ) { cons_t *i = listp(p)? car(p) : p; if ( integerp(i) ) sum += static_cast<real_t>(i->number.integer); else if ( realp(i) ) sum += i->number.real; else if ( rationalp(i) ) sum += real(i->number.rational)->number.real; else raise(runtime_exception("Cannot add real with " + to_s(type_of(i)) + ": " + sprint(i))); } return real(sum); }
cons_t* proc_div(cons_t *p, environment_t *e) { assert_length(p, 2); cons_t *a = car(p); cons_t *b = cadr(p); assert_number(a); assert_number(b); bool exact = (a->number.exact && b->number.exact); if ( zerop(b) ) raise(runtime_exception(format( "Division by zero: %s", sprint(cons(symbol("/"), p)).c_str()))); if ( type_of(a) == type_of(b) ) { if ( integerp(a) ) { // division yields integer? if ( gcd(a->number.integer, b->number.integer) == 0) return integer(a->number.integer / b->number.integer, exact); else return rational(make_rational(a) /= make_rational(b), exact); } else if ( realp(a) ) return real(a->number.real / b->number.real); else if ( rationalp(a) ) return rational(a->number.rational / b->number.rational, exact); else raise(runtime_exception(format("Cannot perform division on %s", indef_art(to_s(type_of(a))).c_str()))); } bool anyrational = (rationalp(a) || rationalp(b)); bool anyinteger = (integerp(a) || integerp(b)); // int/rat or rat/int ==> turn into rational, and not an int if ( anyrational && anyinteger ) return rational(make_rational(a) /= make_rational(b), exact, false); // proceed with real division return proc_divf(p, e); }