/*
* 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_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);
}
static cons_t* verify_library_name(cons_t* p)
{
if ( !listp(p) )
raise(syntax_error(format(
"The library name must be a list, not %s",
indef_art(to_s(type_of(p))).c_str())));
/*
* R7RS: <library name> is a list whose members are ...
*/
for ( cons_t *q = p; !nullp(q); q = cdr(q) ) {
// ... identifiers
if ( type_of(car(q)) == SYMBOL )
continue;
// ... and exact nonnegative integers.
if ( type_of(car(q)) == INTEGER && car(q)->number.integer >= 0 )
continue;
raise(syntax_error("Invalid library name: " + sprint(p)));
}
return p;
}
