diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index 7726cb1..54816bb 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -330,7 +330,7 @@ bitwise-arithmetic-shift positive? negative? expt gcd lcm numerator denominator exact-integer-sqrt quotient+remainder number->string string->number min max - abs truncate fltruncate sra sll + abs truncate fltruncate sra sll real->flonum exact->inexact inexact floor ceiling round log fl=? fl? fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative? sin cos tan asin acos atan sqrt exp @@ -350,7 +350,7 @@ positive? negative? bitwise-and bitwise-not string->number expt gcd lcm numerator denominator exact->inexact inexact floor ceiling round log - exact-integer-sqrt min max abs + exact-integer-sqrt min max abs real->flonum fl=? fl? fl>=? fl+ fl- fl* fl/ flsqrt flmin flzero? flnegative? sra sll exp sin cos tan asin acos atan sqrt truncate fltruncate @@ -1169,6 +1169,15 @@ [else (error 'inexact "not a number" x)]))) + (define real->flonum + (lambda (x) + (cond + [(fixnum? x) ($fixnum->flonum x)] + [(bignum? x) (bignum->flonum x)] + [(ratnum? x) (ratnum->flonum x)] + [(flonum? x) x] + [else + (error 'real->flonum "not a real number" x)]))) (define positive-bignum? (lambda (x) diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 5bc3b0b..d806737 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -854,7 +854,7 @@ [fltan i r fl] [fltruncate i r fl] [flzero? i r fl] - [real->flonum r fl] + [real->flonum i r fl] [make-no-infinities-violation i r fl] [make-no-nans-violation i r fl] [&no-infinities i r fl] @@ -874,7 +874,7 @@ [bytevector-ieee-single-native-ref i r bv] [bytevector-ieee-single-native-set! i r bv] [bytevector-ieee-single-ref i r bv] - [bytevector-ieee-single-set! i r bv] + [bytevector-ieee-single-set! i r bv] [bytevector-length i r bv] [bytevector-s16-native-ref i r bv] [bytevector-s16-native-set! i r bv] diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss index 7c5fad2..a86ed9a 100755 --- a/scheme/todo-r6rs.ss +++ b/scheme/todo-r6rs.ss @@ -53,7 +53,6 @@ (define status-names '( [S scheduled] - [D deferred] [C completed] )) @@ -95,7 +94,7 @@ [/ C ba se] [abs C ba se] [acos C ba se] - [angle D ba se] + [angle S ba se] [append C ba se] [apply C ba se] [asin C ba se] @@ -186,9 +185,9 @@ [list-tail C ba se] [list? C ba se] [log C ba se] - [magnitude D ba se] - [make-polar D ba se] - [make-rectangular D ba se] + [magnitude S ba se] + [make-polar S ba se] + [make-rectangular S ba se] [make-string C ba se] [make-vector C ba se] [map C ba se] @@ -333,10 +332,10 @@ [flceiling C fl] [flcos C fl] [fldenominator C fl] - [fldiv D fl] - [fldiv-and-mod D fl] - [fldiv0 D fl] - [fldiv0-and-mod0 D fl] + [fldiv S fl] + [fldiv-and-mod S fl] + [fldiv0 S fl] + [fldiv0-and-mod0 S fl] [fleven? C fl] [flexp C fl] [flexpt C fl] @@ -347,8 +346,8 @@ [fllog C fl] [flmax C fl] [flmin C fl] - [flmod D fl] - [flmod0 D fl] + [flmod S fl] + [flmod0 S fl] [flnan? C fl] [flnegative? C fl] [flnumerator C fl] @@ -361,7 +360,7 @@ [fltan C fl] [fltruncate C fl] [flzero? C fl] - [real->flonum D fl] + [real->flonum S fl] [make-no-infinities-violation C fl] [make-no-nans-violation C fl] [&no-infinities C fl] @@ -606,12 +605,11 @@ [lookahead-u8 S ip] [make-bytevector C bv] [make-custom-binary-input-port S ip] - [make-custom-binary-input/output-port D ip] + [make-custom-binary-input/output-port S ip] [make-custom-binary-output-port S ip] [make-custom-textual-input-port S ip] - [make-custom-textual-input/output-port D ip] + [make-custom-textual-input/output-port S ip] [make-custom-textual-output-port S ip] - [make-i/o-decoding-error C ip] [make-i/o-encoding-error C ip] [make-i/o-error C ip is fi] @@ -631,7 +629,7 @@ [open-bytevector-input-port S ip] [open-bytevector-output-port S ip] [open-file-input-port S ip] - [open-file-input/output-port D ip] + [open-file-input/output-port S ip] [open-file-output-port S ip] [open-string-input-port S ip] [open-string-output-port S ip] @@ -697,13 +695,13 @@ [hashtable? C ht] [make-eq-hashtable C ht] [make-eqv-hashtable S ht] - [hashtable-hash-function D ht] - [make-hashtable D ht] - [hashtable-equivalence-function D ht] - [equal-hash D ht] - [string-hash D ht] - [string-ci-hash D ht] - [symbol-hash D ht] + [hashtable-hash-function S ht] + [make-hashtable S ht] + [hashtable-equivalence-function S ht] + [equal-hash S ht] + [string-hash S ht] + [string-ci-hash S ht] + [symbol-hash S ht] ;;; [list-sort C sr] [vector-sort C sr] @@ -788,9 +786,9 @@ [string-titlecase S uc] [string-upcase S uc] ;;; - [char-ready? D ] - [interaction-environment D ] - [load D ] + [char-ready? S ] + [interaction-environment S ] + [load S ] ;;; ))