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

* Added fl/.

This commit is contained in:
Abdulaziz Ghuloum 2007-06-13 13:50:19 +03:00
parent dc046a3092
commit ded64db389
3 changed files with 25 additions and 3 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.

25
src/ikarus.numerics.ss
View File

@ -102,7 +102,7 @@
positive? expt gcd lcm numerator denominator exact-integer-sqrt positive? expt gcd lcm numerator denominator exact-integer-sqrt
quotient+remainder number->string string->number min max quotient+remainder number->string string->number min max
exact->inexact floor ceiling round log fl=? fl<? fl<=? fl>? exact->inexact floor ceiling round log fl=? fl<? fl<=? fl>?
fl>=? fl+ fl- fl*) fl>=? fl+ fl- fl* fl/)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $flonums) (ikarus system $flonums)
@ -116,7 +116,7 @@
string->number expt gcd lcm numerator denominator string->number expt gcd lcm numerator denominator
exact->inexact floor ceiling round log exact->inexact floor ceiling round log
exact-integer-sqrt min max exact-integer-sqrt min max
fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl*)) fl=? fl<? fl<=? fl>? fl>=? 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))
@ -1251,6 +1251,27 @@
(error 'fl* "~s is not a flonum" x))] (error 'fl* "~s is not a flonum" x))]
[() (exact->inexact 1)])) [() (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)
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<) (flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<)
(flcmp flfl> flfx> fxfl> flbn> bnfl> $fl>) (flcmp flfl> flfx> fxfl> flbn> bnfl> $fl>)

3
src/makefile.ss
View File

@ -375,6 +375,7 @@
[fl+ i rfl] [fl+ i rfl]
[fl* i rfl] [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]
@ -461,7 +462,7 @@
[with-output-to-file i r] [with-output-to-file i r]
[open-output-file i r] [open-output-file i r]
[open-output-string i] [open-output-string i]
[open-input-string i] [open-input-string i r] ; r6rs?
[get-output-string i] [get-output-string i]
[with-output-to-string i] [with-output-to-string i]
[close-input-port i r] [close-input-port i r]