conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* changed implemenation of flround.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-13 03:10:39 -05:00
parent 3feb49e10c
commit 47f7016b18
2 changed files with 14 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

26
scheme/ikarus.numerics.ss
View File

@ -2104,24 +2104,26 @@
(let ([n ($ratnum-n x)] [d ($ratnum-d x)]) (let ([n ($ratnum-n x)] [d ($ratnum-d x)])
(quotient n d))) (quotient n d)))
(define ($flround x)
($fl/ ($fl* x 5e-324) 5e-324))
(define (flround x) (define (flround x)
;;; FIXME: flround should preserve the sign of -0.0.
(if (flonum? x) (if (flonum? x)
(let ([e ($flonum->exact x)]) ($flround x)
(cond
[(ratnum? e) (exact->inexact ($ratnum-round e))]
[else x]))
(error 'flround "not a flonum" x))) (error 'flround "not a flonum" x)))
;(define (flround x)
; ;;; FIXME: flround should preserve the sign of -0.0.
; (if (flonum? x)
; (let ([e ($flonum->exact x)])
; (cond
; [(ratnum? e) (exact->inexact ($ratnum-round e))]
; [else x]))
; (error 'flround "not a flonum" x)))
(define (round x) (define (round x)
;;; FIXME: flround should preserve the sign of -0.0.
(cond (cond
[(flonum? x) [(flonum? x) ($flround x)]
(let ([e (or ($flonum->exact x)
(error 'round "number has no real value" x))])
(cond
[(ratnum? e) (exact->inexact ($ratnum-round e))]
[else x]))]
[(ratnum? x) ($ratnum-round x)] [(ratnum? x) ($ratnum-round x)]
[(or (fixnum? x) (bignum? x)) x] [(or (fixnum? x) (bignum? x)) x]
[else (error 'round "not a number" x)])) [else (error 'round "not a number" x)]))