* 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,8 +1620,8 @@
       [(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-values ([(q r) (quotient+remainder n d)])
         (let ([r2 (+ r r)]) 
@@ -1635,14 +1637,23 @@
                   [(< r2 d) (- q 1)]
                   [else
                    (if (even? q) q (- q 1))])))))))
-    (cond
-      [(flonum? x) 
+
+  (define ($flround x)
     (let ([e ($flonum->exact 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)]
+        [(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) ($flround x)]
+      [(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]