lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fix * and + to return inexact when given inexact args.

This commit is contained in:
Doug Currie 2017-08-09 14:21:29 -04:00 committed by Lassi Kortela
parent 83fe48525f
commit 901621b9c5
2 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
cvalues.c
View File

@ -1048,6 +1048,7 @@ static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn)
uint64_t Uaccum=0; uint64_t Uaccum=0;
int64_t Saccum = carryIn; int64_t Saccum = carryIn;
double Faccum=0; double Faccum=0;
int32_t inexact = 0;
uint32_t i; uint32_t i;
value_t arg=NIL; value_t arg=NIL;
@ -1075,8 +1076,8 @@ static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn)
Saccum += i64; Saccum += i64;
break; break;
case T_UINT64: Uaccum += *(uint64_t*)a; break; case T_UINT64: Uaccum += *(uint64_t*)a; break;
case T_FLOAT: Faccum += *(float*)a; break; case T_FLOAT: Faccum += *(float*)a; inexact = 1; break;
case T_DOUBLE: Faccum += *(double*)a; break; case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break;
default: default:
goto add_type_error; goto add_type_error;
} }
@ -1085,7 +1086,7 @@ static value_t fl_add_any(value_t *args, u_int32_t nargs, fixnum_t carryIn)
add_type_error: add_type_error:
type_error("+", "number", arg); type_error("+", "number", arg);
} }
if (Faccum != 0) { if (inexact) {
Faccum += Uaccum; Faccum += Uaccum;
Faccum += Saccum; Faccum += Saccum;
return mk_double(Faccum); return mk_double(Faccum);
@ -1159,6 +1160,7 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum)
{ {
uint64_t Uaccum=1; uint64_t Uaccum=1;
double Faccum=1; double Faccum=1;
int32_t inexact = 0;
uint32_t i; uint32_t i;
value_t arg=NIL; value_t arg=NIL;
@ -1186,8 +1188,8 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum)
Saccum *= i64; Saccum *= i64;
break; break;
case T_UINT64: Uaccum *= *(uint64_t*)a; break; case T_UINT64: Uaccum *= *(uint64_t*)a; break;
case T_FLOAT: Faccum *= *(float*)a; break; case T_FLOAT: Faccum *= *(float*)a; inexact = 1; break;
case T_DOUBLE: Faccum *= *(double*)a; break; case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break;
default: default:
goto mul_type_error; goto mul_type_error;
} }
@ -1196,7 +1198,7 @@ static value_t fl_mul_any(value_t *args, u_int32_t nargs, int64_t Saccum)
mul_type_error: mul_type_error:
type_error("*", "number", arg); type_error("*", "number", arg);
} }
if (Faccum != 1) { if (inexact) {
Faccum *= Uaccum; Faccum *= Uaccum;
Faccum *= Saccum; Faccum *= Saccum;
return mk_double(Faccum); return mk_double(Faccum);

4
tests/unittest.lsp
View File

@ -287,5 +287,9 @@
(assert (let ((ts (time.string (time.now)))) (assert (let ((ts (time.string (time.now))))
(eqv? ts (time.string (time.fromstring ts)))))) (eqv? ts (time.string (time.fromstring ts))))))
(assert (equal? 0.0 (+ 0.0 0))) ; tests that + no longer does inexact->exact
(assert (equal? 1.0 (* 1.0 1))) ; tests that * no longer does inexact->exact
(princ "all tests pass\n") (princ "all tests pass\n")
#t #t