* 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

Binary file not shown.

View File

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

View File

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

View File

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