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

* Added fleven? and flodd?

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 22:45:41 -04:00
parent fa63e8723c
commit cb94cf88b2
4 changed files with 30 additions and 6 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.

30
src/ikarus.numerics.ss
View File

@ -9,15 +9,16 @@
(export $flonum->exact $flonum-signed-biased-exponent flonum-parts (export $flonum->exact $flonum-signed-biased-exponent flonum-parts
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 fleven? flodd?
flinteger? flonum-bytes flnan? flfinite? flinfinite?) flinteger? flonum-bytes flnan? flfinite? flinfinite?)
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
(only (ikarus system $fx) $fxzero? $fxlogand) (ikarus system $fx)
(ikarus system $bignums)
(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
fixnum->flonum flsin flcos fltan flasin flacos flatan flsin flcos fltan flasin flacos flatan fleven? flodd?
flinteger? flonum-parts flonum-bytes flnan? flfinite? flinfinite?)) flinteger? flonum-parts flonum-bytes flnan? flfinite? flinfinite?))
(define (flonum-bytes f) (define (flonum-bytes f)
@ -87,6 +88,27 @@
(let ([v ($flonum->exact x)]) (let ([v ($flonum->exact x)])
(or (fixnum? v) (bignum? v)))]))) (or (fixnum? v) (bignum? v)))])))
(define (fleven? x)
(unless (flonum? x)
(error 'fleven? "~s is not a flonum" x))
(let ([v ($flonum->exact x)])
(cond
[(fixnum? v) ($fx= ($fxlogand v 1) 0)]
[(bignum? v)
(foreign-call "ikrt_even_bn" v)]
[else (error 'fleven? "~s is not an integer flonum" x)])))
(define (flodd? x)
(unless (flonum? x)
(error 'flodd? "~s is not a flonum" x))
(let ([v ($flonum->exact x)])
(cond
[(fixnum? v) ($fx= ($fxlogand v 1) 1)]
[(bignum? v)
(not (foreign-call "ikrt_even_bn" v))]
[else (error 'flodd? "~s is not an integer flonum" x)])))
(define (flinteger? x) (define (flinteger? x)
(if (flonum? x) (if (flonum? x)
($flonum-integer? x) ($flonum-integer? x)

2
src/makefile.ss
View File

@ -506,6 +506,8 @@
[flfinite? i] [flfinite? i]
[flinfinite? i] [flinfinite? i]
[flnan? i] [flnan? i]
[fleven? i]
[flodd? i]
[exact? i r] [exact? i r]
[inexact? i r] [inexact? i r]
[rational? i r] [rational? i r]

4
src/todo-r6rs.ss
View File

@ -319,7 +319,7 @@
[fldiv-and-mod S fl] [fldiv-and-mod S fl]
[fldiv0 S fl] [fldiv0 S fl]
[fldiv0-and-mod0 S fl] [fldiv0-and-mod0 S fl]
[fleven? S fl] [fleven? C fl]
[flexp S fl] [flexp S fl]
[flexpt S fl] [flexpt S fl]
[flfinite? C fl] [flfinite? C fl]
@ -334,7 +334,7 @@
[flnan? C fl] [flnan? C fl]
[flnegative? C fl] [flnegative? C fl]
[flnumerator S fl] [flnumerator S fl]
[flodd? S fl] [flodd? C fl]
[flonum? C fl] [flonum? C fl]
[flpositive? C fl] [flpositive? C fl]
[flround C fl] [flround C fl]