* Added flround.

benchmarks/BUGS

@@ -2,7 +2,7 @@
 * ray needs many fl procedures
 * quicksort needs bignum modulo.
 * scheme needs complex? and other stuff.
-* slatex needs string-ci=?
+* slatex needs char-alphabetic?
 * compiler needs string-downcase
 
 * ctak crashes with a bus error.

benchmarks/r6rs-benchmarks/slatex.ss

@@ -10,6 +10,7 @@
     (r6rs) 
     (r6rs unicode)
     (r6rs mutable-pairs)
+    (r6rs i/o simple)
     (r6rs-benchmarks))
 
   (define *op-sys* 'unix)

src/ikarus.numerics.ss

@@ -132,7 +132,8 @@
           abs
           exact->inexact floor ceiling round log fl=? fl<? fl<=? fl>?
           fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative?
-          sin cos atan sqrt)
+          sin cos atan sqrt
+          flround)
   (import 
     (ikarus system $fx)
     (ikarus system $flonums)
@@ -148,7 +149,8 @@
             exact-integer-sqrt min max abs
             fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt flmin
             flzero? flnegative?
-            sin cos atan sqrt))
+            sin cos atan sqrt
+            flround))
 
   (define (fixnum->flonum x)
     (foreign-call "ikrt_fixnum_to_flonum" x))
@@ -1618,31 +1620,40 @@
       [(or (fixnum? x) (bignum? x)) x]
       [else (error 'ceiling "~s is not a number" x)]))
 
-  (define (round x)
+
-    (define (ratnum-round x)
+  (define ($ratnum-round x)
-      (let ([n ($ratnum-n x)] [d ($ratnum-d x)])
+    (let ([n ($ratnum-n x)] [d ($ratnum-d x)])
-        (let-values ([(q r) (quotient+remainder n d)])
+      (let-values ([(q r) (quotient+remainder n d)])
-          (let ([r2 (+ r r)]) 
+        (let ([r2 (+ r r)]) 
-            (if (> n 0) 
+          (if (> n 0) 
+              (cond
+                [(< r2 d) q]
+                [(> r2 d) (+ q 1)]
+                [else
+                 (if (even? q) q (+ q 1))])
+              (let ([r2 (- r2)])
                 (cond
                   [(< r2 d) q]
-                  [(> r2 d) (+ q 1)]
+                  [(< r2 d) (- q 1)]
                   [else
-                   (if (even? q) q (+ q 1))])
+                   (if (even? q) q (- q 1))])))))))
-                (let ([r2 (- r2)])
+
-                  (cond
+  (define ($flround x)
-                    [(< r2 d) q]
+    (let ([e ($flonum->exact x)])
-                    [(< r2 d) (- q 1)]
+      (cond
-                    [else
+        [(not e) x] ;;; infs and nans round to themselves
-                     (if (even? q) q (- q 1))])))))))
+        [(ratnum? e) (exact->inexact ($ratnum-round e))]
+        [else (exact->inexact e)])))
+
+  (define (flround x)
+    (if (flonum? x)
+        ($flround x)
+        (error 'flround "~s is not a flonum" x)))
+
+  (define (round x)
     (cond
-      [(flonum? x) 
+      [(flonum? x) ($flround x)]
-       (let ([e ($flonum->exact x)])
+      [(ratnum? x) ($ratnum-round x)]
-         (cond
-           [(not e) x] ;;; infs and nans round to themselves
-           [(ratnum? e) (exact->inexact (ratnum-round e))]
-           [else (exact->inexact e)]))]
-      [(ratnum? x) (ratnum-round x)]
       [(or (fixnum? x) (bignum? x)) x]
       [else (error 'round "~s is not a number" x)]))
 

src/makefile.ss

@@ -398,6 +398,7 @@
     [flnegative?             i rfl]
     [flpositive?             i rfl]
     [flabs                   i rfl]
+    [flround                 i rfl]
     [fixnum->string          i]
     [string->flonum          i]
     [-                       i r]