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

* Added flnegative?

This commit is contained in:
Abdulaziz Ghuloum 2007-06-13 14:11:39 +03:00
parent 0f910c431f
commit 009d0b2fac
3 changed files with 16 additions and 4 deletions

BIN
src/ikarus.boot
View File

Binary file not shown.

19
src/ikarus.numerics.ss
View File

@ -7,7 +7,8 @@
(library (ikarus flonums) (library (ikarus flonums)
(export $flonum->exact $flonum-signed-biased-exponent flonum-parts (export $flonum->exact $flonum-signed-biased-exponent flonum-parts
inexact->exact $flonum-rational? $flonum-integer? $flzero?) inexact->exact $flonum-rational? $flonum-integer? $flzero?
$flnegative?)
(import (import
(ikarus system $bytevectors) (ikarus system $bytevectors)
(except (ikarus system $flonums) $flonum-signed-biased-exponent (except (ikarus system $flonums) $flonum-signed-biased-exponent
@ -83,6 +84,10 @@
(fx= ($flonum-u8-ref x 2) 0) (fx= ($flonum-u8-ref x 2) 0)
(fx= ($flonum-u8-ref x 1) 0))))) (fx= ($flonum-u8-ref x 1) 0)))))
(define ($flnegative? x)
(let ([b0 ($flonum-u8-ref x 0)])
(fx> b0 127)))
(define ($flonum->exact x) (define ($flonum->exact x)
(let-values ([(pos? be m) (flonum-parts x)]) (let-values ([(pos? be m) (flonum-parts x)])
(cond (cond
@ -114,7 +119,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/ flsqrt flzero?) fl>=? fl+ fl- fl* fl/ flsqrt flzero? flnegative?)
(import (import
(ikarus system $fx) (ikarus system $fx)
(ikarus system $flonums) (ikarus system $flonums)
@ -122,14 +127,14 @@
(ikarus system $bignums) (ikarus system $bignums)
(ikarus system $chars) (ikarus system $chars)
(ikarus system $strings) (ikarus system $strings)
(only (ikarus flonums) $flonum->exact $flzero?) (only (ikarus flonums) $flonum->exact $flzero? $flnegative?)
(except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient (except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient
remainder modulo even? odd? quotient+remainder number->string positive? remainder modulo even? odd? quotient+remainder number->string positive?
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/ flsqrt fl=? fl<? fl<=? fl>? fl>=? fl+ fl- fl* fl/ flsqrt
flzero?)) flzero? flnegative?))
(define (fixnum->flonum x) (define (fixnum->flonum x)
(foreign-call "ikrt_fixnum_to_flonum" x)) (foreign-call "ikrt_fixnum_to_flonum" x))
@ -1482,6 +1487,12 @@
($flzero? x) ($flzero? x)
(error 'flzero? "~s is not a flonum" x)))) (error 'flzero? "~s is not a flonum" x))))
(define flnegative?
(lambda (x)
(if (flonum? x)
($flnegative? x)
(error 'flnegative? "~s is not a flonum" x))))
(define exact-integer-sqrt (define exact-integer-sqrt
(lambda (x) (lambda (x)
(define who 'exact-integer-sqrt) (define who 'exact-integer-sqrt)

1
src/makefile.ss
View File

@ -378,6 +378,7 @@
[fl/ i rfl] [fl/ i rfl]
[flsqrt i rfl] [flsqrt i rfl]
[flzero? i rfl] [flzero? i rfl]
[flnegative? i rfl]
[fixnum->string i] [fixnum->string i]
[string->flonum i] [string->flonum i]
[- i r] [- i r]