diff --git a/src/ikarus.boot b/src/ikarus.boot index e23ae05..d6063c6 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index c1cf95c..d01e883 100644 --- a/src/ikarus.numerics.ss +++ b/src/ikarus.numerics.ss @@ -119,7 +119,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/ flsqrt flzero? flnegative?) + fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative?) (import (ikarus system $fx) (ikarus system $flonums) @@ -133,7 +133,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/ flsqrt + fl=? fl? fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative?)) (define (fixnum->flonum x) @@ -869,6 +869,26 @@ x (error 'min "~s is not a number" x))])) + + (define flmin + (case-lambda + [(x y) + (if (flonum? x) + (if (flonum? y) + (if ($fl< x y) x y) + (error 'flmin "~s is not a flonum" y)) + (error 'flmin "~s is not a flonum" x))] + [(x y z . rest) + (let f ([a (flmin x y)] [b z] [ls rest]) + (cond + [(null? ls) (flmin a b)] + [else + (f (flmin a b) (car ls) (cdr ls))]))] + [(x) + (if (flonum? x) + x + (error 'flmin "~s is not a flonum" x))])) + (define exact->inexact (lambda (x) (cond diff --git a/src/makefile.ss b/src/makefile.ss index 39a0276..4567964 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -376,6 +376,7 @@ [fl* i rfl] [fl- i rfl] [fl/ i rfl] + [flmin i rfl] [flsqrt i rfl] [flzero? i rfl] [flnegative? i rfl]