cons_t* proc_expt(cons_t* p, environment_t*)
{
assert_length(p, 2);
cons_t *base = car(p),
*expn = cadr(p);
assert_number(base);
assert_number(expn);
bool exact = integerp(base) && integerp(expn);
if ( exact ) {
int a = base->number.integer,
n = expn->number.integer,
r = a;
// Per definition
if ( n == 0 )
return integer(1);
if ( n < 0 )
raise(runtime_exception("Negative exponents not implemented"));
// This is a slow version
// TODO: Implement O(log n) version
while ( n-- > 1 )
r *= a;
return integer(r);
}
// Floating point exponentiation
real_t a = number_to_real(base),
n = number_to_real(expn),
r = a;
if ( n == 0.0 )
return real(1.0);
if ( n < 0.0 )
raise(runtime_exception("Negative exponents not implemented"));
while ( floor(n) > 1.0 ) {
r *= a;
n -= 1.0;
}
if ( n > 1.0 )
raise(runtime_exception("Fractional exponents not supported"));
// TODO: Compute r^n, where n is in [0..1)
return real(r);
}
cons_t* proc_positivep(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_number(car(p));
return boolean(integerp(car(p)) ? car(p)->number.integer > 0 :
car(p)->number.real > 0);
}
static int test_clock_alphabet_getIndexByCharacter_correct()
{
int index;
Call(clock_alphabet_getIndexByCharacter('\001', &index));
assert_number(index, CLOCK_SMILEY_FACE_SMILE, "%d", "%d");
return 0;
}
cons_t* proc_infinitep(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_number(car(p));
if ( type_of(car(p)) == INTEGER )
return boolean(false);
return boolean(std::fpclassify(car(p)->number.real) == FP_INFINITE);
}
cons_t* proc_truncate(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_number(car(p));
if ( integerp(car(p)) )
return integer(car(p)->number.integer);
else
return real(truncf(car(p)->number.real));
}
cons_t* proc_finitep(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_number(car(p));
if ( type_of(car(p)) == INTEGER )
return boolean(true);
return boolean(std::isfinite(car(p)->number.real));
}
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_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);
}
cons_t* proc_round(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_number(car(p));
if ( integerp(car(p)) )
return integer(car(p)->number.integer);
else if ( rationalp(car(p)) )
return real(roundf(make_inexact(car(p))->number.real));
assert_type(REAL, car(p));
return real(roundf(car(p)->number.real));
}
/*
* True if number sequence is monotonically decreasing.
*/
cons_t* proc_greater(cons_t* p, environment_t*)
{
assert_length_min(p, 2);
for ( ; !nullp(cdr(p)); p = cdr(p) ) {
if ( nanp(car(p)) || nanp(cadr(p)) )
return boolean(false);
assert_number(car(p));
assert_number(cadr(p));
real_t x = integerp(car(p))? car(p)->number.integer :
car(p)->number.real;
real_t y = integerp(cadr(p))? cadr(p)->number.integer :
cadr(p)->number.real;
if ( !(x > y) )
return boolean(false);
}
return boolean(true);
}
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 int assert_clock_updateUptimeMillis_delta(
unsigned long updateMillis,
unsigned long expectedDelta,
unsigned long *lastMillis)
{
NullCheck(lastMillis);
unsigned long delta;
Call(clock_updateUptimeMillis(updateMillis, lastMillis, &delta));
assert_number(delta, expectedDelta, "%lu", "%lu");
return 0;
}
cons_t* proc_exact_to_inexact(cons_t* p, environment_t*)
{
assert_length(p, 1);
cons_t *q = car(p);
assert_number(q);
assert_exact(q);
cons_t *r = new cons_t();
*r = *q;
r->number.exact = false;
return r;
}
cons_t* proc_number_to_string(cons_t* p, environment_t* e)
{
assert_length(p, 1, 2);
assert_number(car(p));
// int radix = 10;
if ( !nullp(cadr(p)) ) {
assert_type(INTEGER, cadr(p));
//radix = cadr(p)->number.integer;
}
// TODO: Implement use of radix
return proc_to_string(cons(car(p)), e);
}
cons_t* proc_min(cons_t* p, environment_t*)
{
assert_length_min(p, 1);
cons_t *min = car(p);
while ( !nullp(p) ) {
assert_number(car(p));
if ( number_to_real(car(p)) < number_to_real(min) )
min = car(p);
p = cdr(p);
}
return min;
}
cons_t* proc_max(cons_t* p, environment_t*)
{
assert_length_min(p, 1);
cons_t *max = car(p);
while ( !nullp(p) ) {
assert_number(car(p));
if ( number_to_real(car(p)) > number_to_real(max) )
max = car(p);
p = cdr(p);
}
return max;
}
cons_t* proc_inexactp(cons_t* p, environment_t*)
{
assert_length(p, 1);
assert_number(car(p));
return boolean(car(p)->number.exact == false);
}
