* Added expt to (r6rs)

* Added fl+ and fl-.
This commit is contained in:
Abdulaziz Ghuloum 2007-06-13 11:47:30 +03:00
parent 3fb701187e
commit adb65c1b84
3 changed files with 47 additions and 3 deletions

Binary file not shown.

View File

@ -100,7 +100,7 @@
(export + - * / zero? = < <= > >= add1 sub1 quotient remainder (export + - * / zero? = < <= > >= add1 sub1 quotient remainder
positive? expt gcd lcm numerator denominator exact-integer-sqrt positive? expt gcd lcm numerator denominator exact-integer-sqrt
quotient+remainder number->string string->number max quotient+remainder number->string string->number max
exact->inexact floor ceiling log fl<?) exact->inexact floor ceiling log fl<? fl+ fl-)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $flonums) (ikarus system $flonums)
@ -114,7 +114,7 @@
string->number expt gcd lcm numerator denominator string->number expt gcd lcm numerator denominator
exact->inexact floor ceiling log exact->inexact floor ceiling log
exact-integer-sqrt max exact-integer-sqrt max
fl<?)) fl<? fl+ fl-))
(define (fixnum->flonum x) (define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x)) (foreign-call "ikrt_fixnum_to_flonum" x))
@ -1178,6 +1178,48 @@
(error 'fl<? "~s is not a flonum" y)) (error 'fl<? "~s is not a flonum" y))
(error 'fl<? "~s is not a flonum" 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)]))
(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)
($fl- (exact->inexact 0) x)
(error 'fl+ "~s is not a flonum" x))]))
(flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=) (flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=)
(flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<) (flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<)
(flcmp flfl> flfx> fxfl> flbn> bnfl> $fl>) (flcmp flfl> flfx> fxfl> flbn> bnfl> $fl>)

View File

@ -368,6 +368,8 @@
[fxlogor i] [fxlogor i]
[fxlognot i] [fxlognot i]
[fl<? i rfl] [fl<? i rfl]
[fl+ i rfl]
[fl- i rfl]
[fixnum->string i] [fixnum->string i]
[string->flonum i] [string->flonum i]
[- i r] [- i r]
@ -382,7 +384,7 @@
[+ i r] [+ i r]
[add1 i] [add1 i]
[sub1 i] [sub1 i]
[expt i] [expt i r]
[number? i r] [number? i r]
[bignum? i] [bignum? i]
[ratnum? i] [ratnum? i]