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:
Matthew Flatt 2021-02-25 06:34:45 -07:00
parent c2b46b1e96
commit f1fb22f0a7
2 changed files with 40 additions and 12 deletions

View File

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

View File

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