* defined fl*.

* fixed a bug in the identitity of fl+.
This commit is contained in:
Abdulaziz Ghuloum 2007-06-13 13:15:52 +03:00
parent 2dad5b473e
commit 817851f3d2
3 changed files with 25 additions and 3 deletions

Binary file not shown.

View File

@ -102,7 +102,7 @@
positive? expt gcd lcm numerator denominator exact-integer-sqrt
quotient+remainder number->string string->number min max
exact->inexact floor ceiling round log fl=? fl<? fl<=? fl>?
fl>=? fl+ fl-)
fl>=? fl+ fl- fl*)
(import
(ikarus system $fx)
(ikarus system $flonums)
@ -116,7 +116,7 @@
string->number expt gcd lcm numerator denominator
exact->inexact floor ceiling round log
exact-integer-sqrt min max
fl=? fl<? fl<=? fl>? fl>=? fl+ fl-))
fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl*))
(define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x))
@ -1207,7 +1207,7 @@
(if (flonum? x)
x
(error 'fl+ "~s is not a flonum" x))]
[() (exact->inexact 1)]))
[() (exact->inexact 0)]))
(define fl-
@ -1230,6 +1230,27 @@
($fl- (exact->inexact 0) x)
(error 'fl+ "~s is not a flonum" x))]))
(define fl*
(case-lambda
[(x y)
(if (flonum? x)
(if (flonum? y)
($fl* x y)
(error 'fl* "~s is not a flonum" y))
(error 'fl* "~s is not a flonum" x))]
[(x y z)
(fl* (fl* x y) z)]
[(x y z q . rest)
(let f ([ac (fl* (fl* (fl* x y) z) q)] [rest rest])
(if (null? rest)
ac
(f (fl* ac (car rest)) (cdr rest))))]
[(x)
(if (flonum? x)
x
(error 'fl* "~s is not a flonum" x))]
[() (exact->inexact 1)]))
(flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=)
(flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<)
(flcmp flfl> flfx> fxfl> flbn> bnfl> $fl>)

View File

@ -373,6 +373,7 @@
[fl>? i rfl]
[fl>=? i rfl]
[fl+ i rfl]
[fl* i rfl]
[fl- i rfl]
[fixnum->string i]
[string->flonum i]