Chez Scheme: faster bignum printing for power-of-two bases
Insteda of using the generic strategy that involves division, walk through the bits of a bignum to convert to a power-of-two base.
This commit is contained in:
parent
c2b46b1e96
commit
f1fb22f0a7
|
@ -806,6 +806,14 @@
|
|||
(equal? (number->string #x100 16) "100")
|
||||
(equal? (number->string #x100 8) "400")
|
||||
(equal? (number->string #x100 16) "100")
|
||||
(equal? (number->string (* 10 (+ 10 (expt 2 100))) 16)
|
||||
"A0000000000000000000000064")
|
||||
(equal? (number->string (* 10 (+ 10 (expt 2 100))) 8)
|
||||
"24000000000000000000000000000000144")
|
||||
(equal? (number->string (* 10 (+ 10 (expt 2 100))) 4)
|
||||
"2200000000000000000000000000000000000000000000001210")
|
||||
(equal? (number->string (* 10 (+ 10 (expt 2 100))) 2)
|
||||
"10100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001100100")
|
||||
)
|
||||
|
||||
(mat r6rs:number->string
|
||||
|
|
|
@ -918,7 +918,7 @@ floating point returns with (1 0 -1 ...).
|
|||
[else
|
||||
(wrfixits (fx/ n r) r p)
|
||||
(write-char (digit->char (fxremainder n r)) p)])]
|
||||
[(n r d p)
|
||||
[(n r d p) ; add leading zeros as needed to ensure that `d` digits are printed
|
||||
(cond
|
||||
[(fx< n r)
|
||||
(do ([d d (fx- d 1)]) ((fx<= d 1)) (write-char #\0 p))
|
||||
|
@ -939,10 +939,14 @@ floating point returns with (1 0 -1 ...).
|
|||
|
||||
(define wrbigits
|
||||
(let ()
|
||||
; divide-and-conquer, treating bignum as two ``big base'' bigits
|
||||
; first base must be >= sqrt(n); base i+1 must be >= sqrt(base i)
|
||||
; last base must be <= most-positive-fixnum
|
||||
;; divide-and-conquer, treating bignum as two "big base" bigits,
|
||||
;; where a big base is a power of the radix;
|
||||
;; first base must be >= sqrt(n); base i+1 must be >= sqrt(base i);
|
||||
;; last base must be <= most-positive-fixnum
|
||||
(define largest-fixnum-big-base
|
||||
;; maps `radix` to `(cons big-base output-digits)` for a fixnum `big-base`,
|
||||
;; where `output-digits` is the same as `(log big-base radix)`; we need the
|
||||
;; number of digits in the big base to write out any needed leading `0`s
|
||||
(let ([v (make-vector 37)])
|
||||
(do ([b 2 (fx+ b 1)])
|
||||
((fx= b 37) v)
|
||||
|
@ -953,6 +957,9 @@ floating point returns with (1 0 -1 ...).
|
|||
(f bb^2 (* d 2))
|
||||
(cons (cons bb d) '()))))))))
|
||||
(define (big-bases n r)
|
||||
;; get a list of spans of big-base digits, where each span's length is
|
||||
;; a power of two, so it corresponds to some number of squaring of
|
||||
;; the big base; pair that with the number of digits in the span
|
||||
(let ([iln/2 (bitwise-arithmetic-shift-right (+ (bitwise-length n) 1) 1)])
|
||||
(let f ([bb* (vector-ref largest-fixnum-big-base r)])
|
||||
(let ([bb (caar bb*)])
|
||||
|
@ -960,14 +967,27 @@ floating point returns with (1 0 -1 ...).
|
|||
bb*
|
||||
(f (cons (cons (* bb bb) (* (cdar bb*) 2)) bb*)))))))
|
||||
(lambda (n r p)
|
||||
(let f ([n n] [d 0] [bb* (big-bases n r)])
|
||||
(cond
|
||||
[(fixnum? n) (wrfixits n r d p)]
|
||||
[(> (caar bb*) n) (f n d (cdr bb*))]
|
||||
[else
|
||||
(let ([hi.lo ($quotient-remainder n (caar bb*))])
|
||||
(f (car hi.lo) (- d (cdar bb*)) (cdr bb*))
|
||||
(f (cdr hi.lo) (cdar bb*) (cdr bb*)))])))))
|
||||
(case r
|
||||
[(2 4 8 16 32)
|
||||
;; For powers of 2, we can stream through the binary representation
|
||||
(let* ([big-base (car (vector-ref largest-fixnum-big-base r))]
|
||||
[bits (bitwise-length (fx- (car big-base) 1))]
|
||||
[digits (cdr big-base)])
|
||||
(let loop ([start (fx* bits (fx- (fxquotient (fx+ (bitwise-length n) (fx- bits 1)) bits) 1))]
|
||||
[d 0])
|
||||
(wrfixits (bitwise-bit-field n start (fx+ start bits)) r d p)
|
||||
(unless (fx= start 0)
|
||||
(loop (fx- start bits) digits))))]
|
||||
[else
|
||||
;; Use the general divide-and-conquer approach
|
||||
(let f ([n n] [d 0] [bb* (big-bases n r)])
|
||||
(cond
|
||||
[(fixnum? n) (wrfixits n r d p)]
|
||||
[(> (caar bb*) n) (f n d (cdr bb*))]
|
||||
[else
|
||||
(let ([hi.lo ($quotient-remainder n (caar bb*))])
|
||||
(f (car hi.lo) (- d (cdar bb*)) (cdr bb*))
|
||||
(f (cdr hi.lo) (cdar bb*) (cdr bb*)))]))]))))
|
||||
|
||||
(define wrradix
|
||||
(lambda (r p)
|
||||
|
|
Loading…
Reference in New Issue
Block a user