diff --git a/scheme/ikarus.fixnums.ss b/scheme/ikarus.fixnums.ss index bfd0532..8e75213 100644 --- a/scheme/ikarus.fixnums.ss +++ b/scheme/ikarus.fixnums.ss @@ -368,7 +368,7 @@ (sra (- (- fx1 fx2) (+ s0 fx3)) (fixnum-width))))) (module (fixnum->string) - (define mapping-string "0123456789abcdef") + (define mapping-string "0123456789ABCDEF") (define f (lambda (n i j radix) (cond diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index d3c36f8..b4ca9d9 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -1182,6 +1182,7 @@ (cond [(fixnum? x) ($fxeven? x)] [(bignum? x) (even-bignum? x)] + [(flonum? x) (error 'even? "BUG" x)] [else (error 'even? "not an integer" x)])) (define (odd? x) @@ -1189,28 +1190,85 @@ (cond [(fixnum? x) ($fxeven? x)] [(bignum? x) (even-bignum? x)] + [(flonum? x) (error 'odd? "BUG" x)] [else (error 'odd? "not an integer" x)]))) - - (define bignum->string - (lambda (x) - (utf8->string - (foreign-call "ikrt_bignum_to_bytevector" x)))) - (define ratnum->string - (lambda (x) - (string-append - (number->string ($ratnum-n x)) - "/" - (number->string ($ratnum-d x))))) - - (define number->string - (lambda (x) - (cond - [(fixnum? x) (fixnum->string x)] - [(bignum? x) (bignum->string x)] - [(flonum? x) (flonum->string x)] - [(ratnum? x) (ratnum->string x)] - [else (error 'number->string "not a number" x)]))) + (module (number->string) + (module (bignum->string) + (define (bignum->decimal-string x) + (utf8->string (foreign-call "ikrt_bignum_to_bytevector" x))) + (module (bignum->power-string) + (define string-map "0123456789ABCDEF") + (define (init-string x chars) + (if ($bignum-positive? x) + (make-string chars) + (let ([s (make-string ($fxadd1 chars))]) + (string-set! s 0 #\-) + s))) + (define (bignum-bits x) + (define (add-bits b n) + (cond + [($fxzero? b) n] + [else (add-bits ($fxsra b 1) ($fx+ n 1))])) + (let f ([i ($fxsub1 ($bignum-size x))]) + (let ([i ($fxsub1 i)]) + (let ([b ($bignum-byte-ref x i)]) + (cond + [($fxzero? b) (f i)] + [else (add-bits b ($fxsll i 3))]))))) + (define (bignum->power-string x mask shift) + (let ([bits (bignum-bits x)]) + (let ([chars (fxquotient (fx+ bits (fx- shift 1)) shift)]) + (let* ([s (init-string x chars)] + [n ($fx- (string-length s) 1)]) + (let f ([i 0] [j 0] [k 0] [b 0]) + (cond + [($fx= i chars) s] + [($fx< k 8) + (f i ($fxadd1 j) ($fx+ k 8) + ($fxlogor b + ($fxsll ($bignum-byte-ref x j) k)))] + [else + (string-set! s ($fx- n i) + (string-ref string-map + ($fxlogand mask b))) + (f ($fxadd1 i) j ($fx- k shift) ($fxsra b shift))]))))))) + (define (bignum->string x r) + (case r + [(10) (bignum->decimal-string x)] + [(2) (bignum->power-string x 1 1)] + [(8) (bignum->power-string x 7 3)] + [(16) (bignum->power-string x 15 4)] + [else (error 'number->string "BUG")]))) + (define ratnum->string + (lambda (x r) + (string-append + ($number->string ($ratnum-n x) r) + "/" + ($number->string ($ratnum-d x) r)))) + (define $number->string + (lambda (x r) + (cond + [(fixnum? x) (fixnum->string x r)] + [(bignum? x) (bignum->string x r)] + [(flonum? x) + (unless (eqv? r 10) + (error 'number->string + "invalid radix for inexact number" + r x)) + (flonum->string x)] + [(ratnum? x) (ratnum->string x r)] + [else (error 'number->string "not a number" x)]))) + (define number->string + (case-lambda + [(x) ($number->string x 10)] + [(x r) + (unless (memv r '(2 8 10 16)) + (error 'number->string "invalid radix" r)) + ($number->string x r)] + [(x r precision) + (error 'number->string + "BUG: precision is not supported yet")]))) (define modulo (lambda (n m) diff --git a/scheme/run-tests.ss b/scheme/run-tests.ss index 20fee6f..f74f4ed 100755 --- a/scheme/run-tests.ss +++ b/scheme/run-tests.ss @@ -56,4 +56,5 @@ (test-lists) (test-hashtables) (test-input-ports) +(test-bignum-conversion) (printf "Happy Happy Joy Joy\n") diff --git a/scheme/tests/bignums.ss b/scheme/tests/bignums.ss index 5bb2ec2..2bd0e02 100644 --- a/scheme/tests/bignums.ss +++ b/scheme/tests/bignums.ss @@ -1,7 +1,25 @@ (library (tests bignums) - (export test-bignums) + (export test-bignums test-bignum-conversion) (import (ikarus) (tests framework)) + (define (test-bignum-conversion) + (define (test x) + (define (test1 x prefix radix) + (let ([s (string-append prefix + (number->string x radix))]) + (assert (equal? x (read (open-input-string s)))))) + (test1 x "#x" 16) + (test1 x "#o" 8) + (test1 x "#b" 2)) + (test #b11111111111111111111111111111111111111111111111111) + (test #b1111111111111111111111111111111111111111) + (test 39487932748923498234) + (test #b-11111111111111111111111111111111111111111111111111) + (test #b-1111111111111111111111111111111111111111) + (test -39487932748923498234)) + + + (define-tests test-bignums ; first, some simple quotients [(lambda (x) (= x 101)) (quotient 348972 3434)]