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

* Added flfinite?, flinfinite?, and flnan? 

* Fixed a bug that caused all nans to print as -nan.0
This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 22:10:19 -04:00
parent a366a5f20f
commit fa63e8723c
4 changed files with 45 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

38
src/ikarus.numerics.ss
View File

@ -10,14 +10,15 @@
inexact->exact exact $flonum-rational? $flonum-integer? $flzero? inexact->exact exact $flonum-rational? $flonum-integer? $flzero?
$flnegative? flpositive? flabs fixnum->flonum $flnegative? flpositive? flabs fixnum->flonum
flsin flcos fltan flasin flacos flatan flsin flcos fltan flasin flacos flatan
flinteger?) flinteger? flonum-bytes flnan? flfinite? flinfinite?)
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
(only (ikarus system $fx) $fxzero? $fxlogand)
(except (ikarus system $flonums) $flonum-signed-biased-exponent (except (ikarus system $flonums) $flonum-signed-biased-exponent
$flonum-rational? $flonum-integer?) $flonum-rational? $flonum-integer?)
(except (ikarus) inexact->exact exact flpositive? flabs (except (ikarus) inexact->exact exact flpositive? flabs
fixnum->flonum flsin flcos fltan flasin flacos flatan fixnum->flonum flsin flcos fltan flasin flacos flatan
flinteger?)) flinteger? flonum-parts flonum-bytes flnan? flfinite? flinfinite?))
(define (flonum-bytes f) (define (flonum-bytes f)
(unless (flonum? f) (unless (flonum? f)
@ -45,6 +46,16 @@
(fxsll b2 16) (fxsll b2 16)
(fxsll (fxlogand b1 #b1111) 24)) (fxsll (fxlogand b1 #b1111) 24))
(expt 2 24)))))) (expt 2 24))))))
(define ($zero-m? f)
(and ($fxzero? ($flonum-u8-ref f 7))
($fxzero? ($flonum-u8-ref f 6))
($fxzero? ($flonum-u8-ref f 5))
($fxzero? ($flonum-u8-ref f 4))
($fxzero? ($flonum-u8-ref f 3))
($fxzero? ($flonum-u8-ref f 2))
($fxzero? ($fxlogand ($flonum-u8-ref f 1) #b1111))))
(define ($flonum-signed-biased-exponent x) (define ($flonum-signed-biased-exponent x)
(let ([b0 ($flonum-u8-ref x 0)] (let ([b0 ($flonum-u8-ref x 0)]
@ -81,6 +92,25 @@
($flonum-integer? x) ($flonum-integer? x)
(error 'flinteger? "~s is not a flonum" x))) (error 'flinteger? "~s is not a flonum" x)))
(define (flinfinite? x)
(if (flonum? x)
(let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
(and (fx= be 2047) ;;; nans and infs
($zero-m? x)))
(error 'flinfinite? "~s is not a flonum" x)))
(define (flnan? x)
(if (flonum? x)
(let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
(and (fx= be 2047) ;;; nans and infs
(not ($zero-m? x))))
(error 'flnan? "~s is not a flonum" x)))
(define (flfinite? x)
(if (flonum? x)
(let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
(not (fx= be 2047)))
(error 'flfinite? "~s is not a flonum" x)))
(define ($flzero? x) (define ($flzero? x)
(let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))]) (let ([be (fxlogand ($flonum-signed-biased-exponent x) (sub1 (fxsll 1 11)))])
@ -1995,7 +2025,6 @@
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
(ikarus system $flonums) (ikarus system $flonums)
(only (ikarus flonums) flonum-parts)
(except (ikarus) flonum->string string->flonum )) (except (ikarus) flonum->string string->flonum ))
(module (flonum->string) (module (flonum->string)
@ -2130,7 +2159,8 @@
[(= be 2047) [(= be 2047)
(if (= m 0) (if (= m 0)
(if pos? "+inf.0" "-inf.0") (if pos? "+inf.0" "-inf.0")
(if pos? "+nan.0" "-nan.0"))] ;;; Gee! nans have no sign!
"+nan.0")]
[else (error 'flonum->string "cannot happen")])))) [else (error 'flonum->string "cannot happen")]))))
(define (string->flonum x) (define (string->flonum x)

5
src/makefile.ss
View File

@ -503,10 +503,15 @@
[ratnum? i] [ratnum? i]
[integer? i r] [integer? i r]
[flinteger? i] [flinteger? i]
[flfinite? i]
[flinfinite? i]
[flnan? i]
[exact? i r] [exact? i r]
[inexact? i r] [inexact? i r]
[rational? i r] [rational? i r]
[flonum? i] [flonum? i]
[flonum-parts i]
[flonum-bytes i]
[positive? i r] [positive? i r]
[negative? i r] [negative? i r]
[even? i r] [even? i r]

12
src/todo-r6rs.ss
View File

@ -322,21 +322,21 @@
[fleven? S fl] [fleven? S fl]
[flexp S fl] [flexp S fl]
[flexpt S fl] [flexpt S fl]
[flfinite? S fl] [flfinite? C fl]
[flfloor S fl] [flfloor S fl]
[flinfinite? S fl] [flinfinite? C fl]
[flinteger? S fl] [flinteger? C fl]
[fllog S fl] [fllog S fl]
[flmax C fl] [flmax C fl]
[flmin C fl] [flmin C fl]
[flmod S fl] [flmod S fl]
[flmod0 S fl] [flmod0 S fl]
[flnan? S fl] [flnan? C fl]
[flnegative? S fl] [flnegative? C fl]
[flnumerator S fl] [flnumerator S fl]
[flodd? S fl] [flodd? S fl]
[flonum? C fl] [flonum? C fl]
[flpositive? S fl] [flpositive? C fl]
[flround C fl] [flround C fl]
[flsin C fl] [flsin C fl]
[flsqrt S fl] [flsqrt S fl]