Merge pull request #524 from yorickhardy/master

Implement r7rs round to even behaviour for half integers

include/cyclone/runtime.h

@@ -504,6 +504,7 @@ int Cyc_have_mstreams();
   } \
   return_closcall1(data, cont, &d)
 
+double round_to_nearest_even(double);
 void Cyc_exact(void *data, object cont, object z);
 object Cyc_exact_no_cps(void *data, object ptr, object z);
 

runtime.c

@@ -8765,6 +8765,11 @@ int num2ratio(double x, double *numerator, double *denominator)
   return 0;
 }
 
+double round_to_nearest_even(double x)
+{
+ return x-remainder(x,1.0);
+}
+
 /**
  * Receive a Scheme number and pass requested portion of a rational number to
  * the continuation `cont`. Pass numerator if `numerator` is true, else the

scheme/base.sld

@@ -1372,9 +1372,9 @@
     " return_double_op_no_cps(data, ptr, trunc, z);")
   (define-c round
     "(void *data, int argc, closure _, object k, object z)"
-    " return_double_op(data, k, round, z); "
+    " return_double_op(data, k, round_to_nearest_even, z); "
     "(void *data, object ptr, object z)"
-    " return_double_op_no_cps(data, ptr, round, z);")
+    " return_double_op_no_cps(data, ptr, round_to_nearest_even, z);")
   (define-c exact
     "(void *data, int argc, closure _, object k, object z)"
     " Cyc_exact(data, k, z); "

tests/base.scm

@@ -91,6 +91,9 @@
   (test 4.0  (ceiling 3.5))
   (test 3.0  (truncate 3.5))
   (test 4.0  (round 3.5))
+  (test 2.0  (round 2.5))
+  (test -4.0 (round -3.5))
+  (test -2.0 (round -2.5))
   (test 4.0  (round 7/2)) ;; Rationals not supported, so result is inexact
   (test 7    (round 7))