parent
3fb701187e
commit
adb65c1b84
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -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>)
|
||||||
|
|
|
@ -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]
|
||||||
|
|
Loading…
Reference in New Issue