shithub: femtolisp

Download patch

ref: 2bb1c980e25fce857906ad619986a9f001889fcf
parent: db4982b0ed1344608625a91b576a632d89c64ff2
author: Doug Currie <github.9.eeeeeee@spamgourmet.com>
date: Wed Aug 9 10:21:29 EDT 2017 

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


--- a/cvalues.c
+++ b/cvalues.c
@@ -1048,6 +1048,7 @@
     uint64_t Uaccum=0;
     int64_t Saccum = carryIn;
     double Faccum=0;
+    int32_t inexact = 0;
     uint32_t i;
     value_t arg=NIL;
 
@@ -1075,8 +1076,8 @@
                     Saccum += i64;
                 break;
             case T_UINT64: Uaccum += *(uint64_t*)a; break;
-            case T_FLOAT:  Faccum += *(float*)a; break;
-            case T_DOUBLE: Faccum += *(double*)a; break;
+            case T_FLOAT:  Faccum += *(float*)a; inexact = 1; break;
+            case T_DOUBLE: Faccum += *(double*)a; inexact = 1; break;
             default:
                 goto add_type_error;
             }
@@ -1085,7 +1086,7 @@
     add_type_error:
         type_error("+", "number", arg);
     }
-    if (Faccum != 0) {
+    if (inexact) {
         Faccum += Uaccum;
         Faccum += Saccum;
         return mk_double(Faccum);
@@ -1159,6 +1160,7 @@
 {
     uint64_t Uaccum=1;
     double Faccum=1;
+    int32_t inexact = 0;
     uint32_t i;
     value_t arg=NIL;
 
@@ -1186,8 +1188,8 @@
                     Saccum *= i64;
                 break;
             case T_UINT64: Uaccum *= *(uint64_t*)a; break;
-            case T_FLOAT:  Faccum *= *(float*)a; break;
-            case T_DOUBLE: Faccum *= *(double*)a; break;
+            case T_FLOAT:  Faccum *= *(float*)a; inexact = 1; break;
+            case T_DOUBLE: Faccum *= *(double*)a; inexact = 1; break;
             default:
                 goto mul_type_error;
             }
@@ -1196,7 +1198,7 @@
     mul_type_error:
         type_error("*", "number", arg);
     }
-    if (Faccum != 1) {
+    if (inexact) {
         Faccum *= Uaccum;
         Faccum *= Saccum;
         return mk_double(Faccum);
--- a/tests/unittest.lsp
+++ b/tests/unittest.lsp
@@ -287,5 +287,9 @@
     (assert (let ((ts (time.string (time.now))))
                 (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")
 #t