shithub: femtolisp

Info  •  Files  •  Log

Merge pull request #49 from dcurrie/fl_add_any-and-fl_mul_any_should-not-inexact-

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