* Partial fix for bug 160780: missing 2 and 3 arg forms of number->string

- second argument is implemented, precision is yet to be done.
This commit is contained in:
Abdulaziz Ghuloum 2007-11-07 22:28:42 -05:00
parent 75705649e2
commit df46913530
4 changed files with 99 additions and 22 deletions

View File

@ -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

View File

@ -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)
(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
[(fixnum? x) (fixnum->string x)]
[(bignum? x) (bignum->string x)]
[(flonum? x) (flonum->string x)]
[(ratnum? x) (ratnum->string x)]
[($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)

View File

@ -56,4 +56,5 @@
(test-lists)
(test-hashtables)
(test-input-ports)
(test-bignum-conversion)
(printf "Happy Happy Joy Joy\n")

View File

@ -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)]