R5RS compatability fix for expt (SourceForge bug #3399332)

This commit is contained in:
Kevin Cozens 2011-08-30 12:00:00 -04:00
parent 7ab6704f78
commit a8966b8485
1 changed files with 15 additions and 3 deletions

View File

@ -3340,11 +3340,23 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
if(cdr(sc->args)==sc->NIL) {
Error_0(sc,"expt: needs two arguments");
} else {
double result;
int real_result=1;
pointer y=cadr(sc->args);
if (num_is_integer(x) && num_is_integer(y))
real_result=0;
/* This 'if' is an R5RS compatability fix. */
if (rvalue(x) == 0 && rvalue(y) < 0)
s_return(sc, mk_real(sc, 0));
s_return(sc, mk_real(sc, pow(rvalue(x),rvalue(y))));
/* NOTE: Remove this 'if' fix for R6RS. */
if (rvalue(x) == 0 && rvalue(y) < 0) {
result = 0.0;
} else {
result = pow(rvalue(x),rvalue(y));
}
if (real_result) {
s_return(sc, mk_real(sc, result));
} else {
s_return(sc, mk_integer(sc, result));
}
}
case OP_FLOOR: