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

* Added flnumerator and fldenominator

This commit is contained in:
Abdulaziz Ghuloum 2007-09-10 23:30:17 -04:00
parent 1c86a105c5
commit ad3f96d2ad
4 changed files with 26 additions and 4 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.

24
src/ikarus.numerics.ss
View File

@ -10,7 +10,7 @@
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 fleven? flodd? flsin flcos fltan flasin flacos flatan fleven? flodd?
flfloor flceiling flfloor flceiling flnumerator fldenominator
flinteger? flonum-bytes flnan? flfinite? flinfinite?) flinteger? flonum-bytes flnan? flfinite? flinfinite?)
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
@ -20,7 +20,7 @@
$flonum-rational? $flonum-integer?) $flonum-rational? $flonum-integer?)
(except (ikarus) inexact->exact exact flpositive? flabs fixnum->flonum (except (ikarus) inexact->exact exact flpositive? flabs fixnum->flonum
flsin flcos fltan flasin flacos flatan fleven? flodd? flsin flcos fltan flasin flacos flatan fleven? flodd?
flfloor flceiling flfloor flceiling flnumerator fldenominator
flinteger? flonum-parts flonum-bytes flnan? flfinite? flinfinite?)) flinteger? flonum-parts flonum-bytes flnan? flfinite? flinfinite?))
(define (flonum-bytes f) (define (flonum-bytes f)
@ -90,6 +90,24 @@
(let ([v ($flonum->exact x)]) (let ([v ($flonum->exact x)])
(or (fixnum? v) (bignum? v)))]))) (or (fixnum? v) (bignum? v)))])))
(define (flnumerator x)
(unless (flonum? x)
(error 'flnumerator "~s is not a flonum" x))
(cond
[($flonum-integer? x) x]
[($flonum-rational? x)
(exact->inexact (numerator ($flonum->exact x)))]
[else x]))
(define (fldenominator x)
(unless (flonum? x)
(error 'fldenominator "~s is not a flonum" x))
(cond
[($flonum-integer? x) 1.0]
[($flonum-rational? x)
(exact->inexact (numerator ($flonum->exact x)))]
[(flnan? x) x]
[else 1.0]))
(define (fleven? x) (define (fleven? x)
(unless (flonum? x) (unless (flonum? x)
@ -1843,6 +1861,8 @@
[else x])) [else x]))
(error 'flround "~s is not a flonum" x))) (error 'flround "~s is not a flonum" x)))
(define (round x) (define (round x)
(cond (cond
[(flonum? x) [(flonum? x)

2
src/makefile.ss
View File

@ -478,6 +478,8 @@
[flfloor i rfl] [flfloor i rfl]
[flround i rfl] [flround i rfl]
[flceiling i rfl] [flceiling i rfl]
[flnumerator i rfl]
[fldenominator i rfl]
[fixnum->string i] [fixnum->string i]
[string->flonum i] [string->flonum i]
[- i r] [- i r]

4
src/todo-r6rs.ss
View File

@ -314,7 +314,7 @@
[flatan C fl] [flatan C fl]
[flceiling C fl] [flceiling C fl]
[flcos C fl] [flcos C fl]
[fldenominator S fl] [fldenominator C fl]
[fldiv S fl] [fldiv S fl]
[fldiv-and-mod S fl] [fldiv-and-mod S fl]
[fldiv0 S fl] [fldiv0 S fl]
@ -333,7 +333,7 @@
[flmod0 S fl] [flmod0 S fl]
[flnan? C fl] [flnan? C fl]
[flnegative? C fl] [flnegative? C fl]
[flnumerator S fl] [flnumerator C fl]
[flodd? C fl] [flodd? C fl]
[flonum? C fl] [flonum? C fl]
[flpositive? C fl] [flpositive? C fl]