suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

read: avoid quadratic-time string->number integer conversion

Browse Source 
For bases other than powers of 2, I think reading is at least
O(n^1.58), due to multiplication with Karatsubra --- but that turns
out to be a lot faster than O(n^2) by the time you get to 1M digits.
For powers of 2, the time should be linear.
This commit is contained in:
Matthew Flatt 2021-02-25 14:37:19 -07:00
parent 70c763833d
commit 0ab75d1675
3 changed files with 309 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

109
racket/src/bc/src/startup.inc
View File

@ -56428,6 +56428,61 @@ static const char *startup_source =
"(let-values()(trim-number s_0 start_0(fx- end_0 1)))"
"(let-values()(substring s_0 start_0 end_0)))))))"
"(define-values"
"(add-digit)"
"(lambda(d_0 c_0 radix_0)"
"(begin"
"(if(pair? d_0)"
"(let-values()"
"(let-values(((p_0)(car d_0)))"
"(let-values(((digits_0)(add-digit(car p_0) c_0 radix_0)))"
"(if(pair? digits_0)"
"(list*(car digits_0)(cons(cdr digits_0)(cdr p_0))(cdr d_0))"
"(cons(cons digits_0(fx+ 1(cdr p_0)))(cdr d_0))))))"
"(if(eqv? d_0 0)"
"(let-values() c_0)"
"(if(< d_0(expt 2 100))(let-values()(+(* d_0 radix_0) c_0))(let-values()(cons(cons c_0 1) d_0))))))))"
"(define-values"
"(digits->integer)"
"(lambda(d_0 radix_0)"
"(begin"
"(if(pair? d_0)"
"(let-values()"
"(let-values(((len_0)"
"((letrec-values(((loop_0)"
"(lambda(d_1)(begin 'loop(if(pair? d_1)(fx+ 1(loop_0(cdr d_1))) 1)))))"
" loop_0)"
" d_0)))"
"((letrec-values(((loop_0)"
"(lambda(d_1 len_1)"
"(begin"
" 'loop"
"(if(fx= len_1 1)"
"(let-values()(if(pair? d_1)(caar d_1) d_1))"
"(let-values()"
"(let-values(((hi-len_0)(fxrshift len_1 1)))"
"(let-values(((lo-len_0)(fx- len_1 hi-len_0)))"
"(let-values(((hi_0)(loop_0 d_1 hi-len_0)))"
"((letrec-values(((split-loop_0)"
"(lambda(shift_0 hi-len_1 d_2)"
"(begin"
" 'split-loop"
"(if(fx= hi-len_1 0)"
"(+"
" hi_0"
"(*(expt radix_0 shift_0)(loop_0 d_2 lo-len_0)))"
"(split-loop_0"
"(fx+ shift_0(cdar d_2))"
"(fx- hi-len_1 1)"
"(cdr d_2)))))))"
" split-loop_0)"
" 0"
" hi-len_0"
" d_1))))))))))"
" loop_0)"
" d_0"
" len_0)))"
"(let-values() d_0)))))"
"(define-values"
"(do-string->number.1)"
"(lambda(radix-set?33_0 s35_0 start36_0 end37_0 radix38_0 exactness39_0 convert-mode40_0 single-mode41_0)"
"(begin"
@ -56674,7 +56729,7 @@ static const char *startup_source =
"(read-integer)"
"(lambda(sgn_0 n_0 s_0 start_0 end_0 radix_0 state_0)"
"(begin"
"(let-values(((get-n_0)(lambda()(begin 'get-n(* sgn_0 n_0)))))"
"(let-values(((get-n_0)(lambda()(begin 'get-n(* sgn_0(digits->integer n_0 radix_0))))))"
"(let-values(((c_0)"
"(if(fx= start_0 end_0)"
" 'eof"
@ -56684,12 +56739,12 @@ static const char *startup_source =
"(let-values(((sgn108_0) sgn_0)((temp109_0)(get-n_0))((s110_0) s_0)((state111_0) state_0))"
"(finish.1 #f sgn108_0 temp109_0 s110_0 state111_0)))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()(read-integer sgn_0(+(* n_0 radix_0) c_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(let-values()(read-integer sgn_0(add-digit n_0 c_0 radix_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))"
"(let-values()"
"(read-decimal"
" sgn_0"
" n_0"
"(digits->integer n_0 radix_0)"
" 0"
" s_0"
"(fx+ 1 start_0)"
@ -56749,7 +56804,7 @@ static const char *startup_source =
"(let-values()"
"(read-approx"
" sgn_0"
" n_0"
"(digits->integer n_0 radix_0)"
" 1"
" #f"
" s_0"
@ -56789,14 +56844,17 @@ static const char *startup_source =
"(lambda()"
"(begin"
" 'get-n"
" (if n_0 (lazy-number (* sgn_0 n_0) radix_0 (- exp_0)) (bad-no-digits \".\" s_0 state_0))))))"
"(if n_0"
"(lazy-number(* sgn_0(digits->integer n_0 radix_0)) radix_0(- exp_0))"
" (bad-no-digits \".\" s_0 state_0))))))"
"(let-values(((c_0)"
"(if(fx= start_0 end_0)"
" 'eof"
"(let-values(((c_0)(string-ref s_0 start_0)))(maybe-digit c_0 radix_0)))))"
"(if(let-values(((or-part_0)(eqv? c_0 'eof)))(if or-part_0 or-part_0 #f))"
"(let-values()"
"(let-values(((or-part_0)(if n_0(fast-inexact state_0 sgn_0 n_0 radix_0 0 -1 exp_0) #f)))"
"(let-values(((or-part_0)"
"(if n_0(fast-inexact state_0 sgn_0(digits->integer n_0 radix_0) radix_0 0 -1 exp_0) #f)))"
"(if or-part_0"
" or-part_0"
"(let-values(((v_0)(get-n_0)))"
@ -56823,7 +56881,7 @@ static const char *startup_source =
"(let-values()"
"(read-decimal"
" sgn_0"
"(+(*(let-values(((or-part_0) n_0))(if or-part_0 or-part_0 0)) radix_0) c_0)"
"(add-digit(let-values(((or-part_0) n_0))(if or-part_0 or-part_0 0)) c_0 radix_0)"
"(fx+ 1 exp_0)"
" s_0"
"(fx+ 1 start_0)"
@ -56871,7 +56929,7 @@ static const char *startup_source =
"(if n_0"
"(read-exponent"
" sgn_0"
"(* sgn_0 n_0)"
"(* sgn_0(digits->integer n_0 radix_0))"
"(- exp_0)"
" s_0"
"(fx+ 1 start_0)"
@ -56885,7 +56943,16 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))"
"(let-values()"
"(if n_0"
"(read-approx sgn_0 n_0(fx- 0 exp_0) #t s_0(fx+ 1 start_0) end_0 radix_0 state_0)"
"(read-approx"
" sgn_0"
"(digits->integer n_0 radix_0)"
"(fx- 0 exp_0)"
" #t"
" s_0"
"(fx+ 1 start_0)"
" end_0"
" radix_0"
" state_0)"
" (bad-misplaced \"#\" s_0 state_0)))"
"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))"
"(if or-part_0"
@ -57112,7 +57179,7 @@ static const char *startup_source =
"(begin"
" 'get-n"
"(if exp2_0"
"(lazy-number sgn-n_0 radix_0(+ exp_0(* sgn2_0 exp2_0)))"
"(lazy-number sgn-n_0 radix_0(+ exp_0(* sgn2_0(digits->integer exp2_0 radix_0))))"
"(if(eq?(state->convert-mode state_0) 'must-read)"
" (let-values () (format \"empty exponent `~.a`\" s_0))"
"(let-values() #f)))))))"
@ -57125,7 +57192,14 @@ static const char *startup_source =
"(let-values(((or-part_0)"
"(if exp2_0"
"(if(number? sgn-n_0)"
"(fast-inexact state_0(if(eqv? sgn-n_0 0) sgn_0 1) sgn-n_0 radix_0 exp_0 sgn2_0 exp2_0)"
"(fast-inexact"
" state_0"
"(if(eqv? sgn-n_0 0) sgn_0 1)"
" sgn-n_0"
" radix_0"
" exp_0"
" sgn2_0"
"(digits->integer exp2_0 radix_0))"
" #f)"
" #f)))"
"(if or-part_0"
@ -57139,7 +57213,8 @@ static const char *startup_source =
" v_0))))))"
"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))"
"(let-values()"
"(let-values(((new-exp2_0)(+(if exp2_0(* exp2_0 radix_0) 0) c_0)))"
"(let-values(((new-exp2_0)"
"(add-digit(let-values(((or-part_0) exp2_0))(if or-part_0 or-part_0 0)) c_0 radix_0)))"
"(read-signed-exponent"
" sgn_0"
" sgn-n_0"
@ -57437,7 +57512,11 @@ static const char *startup_source =
"(begin"
"(let-values(((get-n_0)"
"(lambda()"
" (begin 'get-n (if d_0 (lazy-divide sgn-n_0 d_0 'exact) (bad-no-digits \"/\" s_0 state_0))))))"
"(begin"
" 'get-n"
"(if d_0"
"(lazy-divide sgn-n_0(digits->integer d_0 radix_0) 'exact)"
" (bad-no-digits \"/\" s_0 state_0))))))"
"(let-values(((c_0)"
"(if(fx= start_0 end_0)"
" 'eof"
@ -57456,7 +57535,7 @@ static const char *startup_source =
"(read-rational"
" sgn_0"
" sgn-n_0"
"(+(if d_0(* d_0 radix_0) 0) c_0)"
"(add-digit(let-values(((or-part_0) d_0))(if or-part_0 or-part_0 0)) c_0 radix_0)"
" s_0"
"(fx+ 1 start_0)"
" end_0"
@ -57470,7 +57549,7 @@ static const char *startup_source =
"(read-denom-approx"
" sgn_0"
" sgn-n_0"
" d_0"
"(digits->integer d_0 radix_0)"
" 1"
" s_0"
"(fx+ 1 start_0)"

199
racket/src/cs/schemified/expander.scm
View File

@ -63642,6 +63642,65 @@
(if or-part_0 or-part_0 (eqv? c_0 '#\x49))))
(trim-number s_0 start_0 (fx- end_0 1))
(substring s_0 start_0 end_0)))))
(define add-digit
(lambda (d_0 c_0 radix_0)
(if (pair? d_0)
(let ((p_0 (car d_0)))
(let ((digits_0 (add-digit (car p_0) c_0 radix_0)))
(if (pair? digits_0)
(let ((app_0 (car digits_0)))
(let ((app_1
(let ((app_1 (cdr digits_0))) (cons app_1 (cdr p_0)))))
(list* app_0 app_1 (cdr d_0))))
(let ((app_0 (cons digits_0 (fx+ 1 (cdr p_0)))))
(cons app_0 (cdr d_0))))))
(if (eqv? d_0 0)
c_0
(if (< d_0 1267650600228229401496703205376)
(+ (* d_0 radix_0) c_0)
(cons (cons c_0 1) d_0))))))
(define digits->integer
(lambda (d_0 radix_0)
(if (pair? d_0)
(let ((len_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (d_1)
(begin (if (pair? d_1) (fx+ 1 (loop_0 (cdr d_1))) 1))))))
(loop_0 d_0))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (d_1 len_1)
(begin
(if (fx= len_1 1)
(if (pair? d_1) (caar d_1) d_1)
(let ((hi-len_0 (fxrshift len_1 1)))
(let ((lo-len_0 (fx- len_1 hi-len_0)))
(let ((hi_0 (loop_0 d_1 hi-len_0)))
(letrec*
((split-loop_0
(|#%name|
split-loop
(lambda (shift_0 hi-len_1 d_2)
(begin
(if (fx= hi-len_1 0)
(+
hi_0
(let ((app_0 (expt radix_0 shift_0)))
(* app_0 (loop_0 d_2 lo-len_0))))
(let ((app_0 (fx+ shift_0 (cdar d_2))))
(let ((app_1 (fx- hi-len_1 1)))
(split-loop_0
app_0
app_1
(cdr d_2))))))))))
(split-loop_0 0 hi-len_0 d_1)))))))))))
(loop_0 d_0 len_0)))
d_0)))
(define do-string->number.1
(|#%name|
do-string->number
@ -63937,7 +63996,10 @@
(bad-digit c_0 s_0 state_0)))))))))
(define read-integer
(lambda (sgn_0 n_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0 (|#%name| get-n (lambda () (begin (* sgn_0 n_0))))))
(let ((get-n_0
(|#%name|
get-n
(lambda () (begin (* sgn_0 (digits->integer n_0 radix_0)))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
@ -63947,7 +64009,7 @@
(let ((temp109_0 (get-n_0)))
(finish.1 #f sgn_0 temp109_0 s_0 state_0))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((app_0 (+ (* n_0 radix_0) c_0)))
(let ((app_0 (add-digit n_0 c_0 radix_0)))
(read-integer
sgn_0
app_0
@ -63958,16 +64020,17 @@
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (fx+ 1 start_0)))
(read-decimal
sgn_0
n_0
0
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(let ((app_0 (digits->integer n_0 radix_0)))
(let ((app_1 (fx+ 1 start_0)))
(read-decimal
sgn_0
app_0
0
s_0
app_1
end_0
radix_0
(set-exactness.1 #f state_0 'approx))))
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0
or-part_0
@ -64041,17 +64104,18 @@
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (fx+ 1 start_0)))
(read-approx
sgn_0
n_0
1
#f
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(let ((app_0 (digits->integer n_0 radix_0)))
(let ((app_1 (fx+ 1 start_0)))
(read-approx
sgn_0
app_0
1
#f
s_0
app_1
end_0
radix_0
(set-exactness.1 #f state_0 'approx))))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
@ -64102,7 +64166,7 @@
(lambda ()
(begin
(if n_0
(let ((app_0 (* sgn_0 n_0)))
(let ((app_0 (* sgn_0 (digits->integer n_0 radix_0))))
(lazy-number app_0 radix_0 (- exp_0)))
(bad-no-digits "." s_0 state_0)))))))
(let ((c_0
@ -64113,7 +64177,14 @@
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((or-part_0
(if n_0
(fast-inexact state_0 sgn_0 n_0 radix_0 0 -1 exp_0)
(fast-inexact
state_0
sgn_0
(digits->integer n_0 radix_0)
radix_0
0
-1
exp_0)
#f)))
(if or-part_0
or-part_0
@ -64134,7 +64205,7 @@
end_0
radix_0
state_0)
(let ((app_0 (+ (* (if n_0 n_0 0) radix_0) c_0)))
(let ((app_0 (add-digit (if n_0 n_0 0) c_0 radix_0)))
(let ((app_1 (fx+ 1 exp_0)))
(read-decimal
sgn_0
@ -64197,7 +64268,7 @@
or-part_11
#f))))))))))))))))))))))))
(if n_0
(let ((app_0 (* sgn_0 n_0)))
(let ((app_0 (* sgn_0 (digits->integer n_0 radix_0))))
(let ((app_1 (- exp_0)))
(let ((app_2 (fx+ 1 start_0)))
(read-exponent
@ -64216,17 +64287,18 @@
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(if n_0
(let ((app_0 (fx- 0 exp_0)))
(read-approx
sgn_0
n_0
app_0
#t
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(let ((app_0 (digits->integer n_0 radix_0)))
(let ((app_1 (fx- 0 exp_0)))
(read-approx
sgn_0
app_0
app_1
#t
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(bad-misplaced "#" s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
@ -64565,7 +64637,10 @@
(lambda ()
(begin
(if exp2_0
(lazy-number sgn-n_0 radix_0 (+ exp_0 (* sgn2_0 exp2_0)))
(lazy-number
sgn-n_0
radix_0
(+ exp_0 (* sgn2_0 (digits->integer exp2_0 radix_0))))
(if (eq? (state->convert-mode state_0) 'must-read)
(format "empty exponent `~.a`" s_0)
#f)))))))
@ -64578,14 +64653,15 @@
(let ((or-part_0
(if exp2_0
(if (number? sgn-n_0)
(fast-inexact
state_0
(if (eqv? sgn-n_0 0) sgn_0 1)
sgn-n_0
radix_0
exp_0
sgn2_0
exp2_0)
(let ((app_0 (if (eqv? sgn-n_0 0) sgn_0 1)))
(fast-inexact
state_0
app_0
sgn-n_0
radix_0
exp_0
sgn2_0
(digits->integer exp2_0 radix_0)))
#f)
#f)))
(if or-part_0
@ -64596,7 +64672,7 @@
v_0
(finish.1 #f sgn_0 v_0 s_0 state_0)))))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((new-exp2_0 (+ (if exp2_0 (* exp2_0 radix_0) 0) c_0)))
(let ((new-exp2_0 (add-digit (if exp2_0 exp2_0 0) c_0 radix_0)))
(read-signed-exponent
sgn_0
sgn-n_0
@ -64961,7 +65037,7 @@
(lambda ()
(begin
(if d_0
(lazy-divide sgn-n_0 d_0 'exact)
(lazy-divide sgn-n_0 (digits->integer d_0 radix_0) 'exact)
(bad-no-digits "/" s_0 state_0)))))))
(let ((c_0
(if (fx= start_0 end_0)
@ -64975,7 +65051,7 @@
v_0
(finish.1 #f sgn_0 v_0 s_0 state_0)))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((app_0 (+ (if d_0 (* d_0 radix_0) 0) c_0)))
(let ((app_0 (add-digit (if d_0 d_0 0) c_0 radix_0)))
(read-rational
sgn_0
sgn-n_0
@ -64991,17 +65067,18 @@
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(if d_0
(let ((app_0 (fx+ 1 start_0)))
(read-denom-approx
sgn_0
sgn-n_0
d_0
1
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(let ((app_0 (digits->integer d_0 radix_0)))
(let ((app_1 (fx+ 1 start_0)))
(read-denom-approx
sgn_0
sgn-n_0
app_0
1
s_0
app_1
end_0
radix_0
(set-exactness.1 #f state_0 'approx))))
(bad-misplaced "#" s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0

92
racket/src/expander/read/number.rkt
View File

@ -426,6 +426,62 @@
(trim-number s start (fx- end 1))]
[else (substring s start end)]))
;; ----------------------------------------
;; The simple strategy of accumuling digits --- adding a digit to
;; the accumulator muliplties by the radix --- is O(n^2). A
;; "digits" starts with that simple strategy, but it then falls
;; back to a list representation if the accumulator gets large,
;; and accumulated values are combined in a divide-and-conquer
;; style.
;;;;
;; A digits is either
;; - val-integer
;; - (cons (cons val-integer shift-integer) digits)
;; where `shift-integer` is an amount to shift `digits` by radix
;; before adding `val-integer`
(define (add-digit d c radix)
(cond
[(pair? d)
(define p (car d))
(define digits (add-digit (car p) c radix))
(if (pair? digits)
(list* (car digits)
(cons (cdr digits) (cdr p))
(cdr d))
(cons (cons digits (fx+ 1 (cdr p)))
(cdr d)))]
[(eqv? d 0) c]
[(< d (expt 2 100)) (+ (* d radix) c)]
[else
(cons (cons c 1) d)]))
(define (digits->integer d radix)
(cond
[(pair? d)
(define len (let loop ([d d])
(if (pair? d)
(fx+ 1 (loop (cdr d)))
1)))
(let loop ([d d] [len len])
(cond
[(fx= len 1) (if (pair? d)
(caar d)
d)]
[else
(define hi-len (fxrshift len 1))
(define lo-len (fx- len hi-len))
(define hi (loop d hi-len))
(let split-loop ([shift 0] [hi-len hi-len] [d d])
(if (fx= hi-len 0)
(+ hi
(* (expt radix shift)
(loop d lo-len)))
(split-loop (fx+ shift (cdar d))
(fx- hi-len 1)
(cdr d))))]))]
[else d]))
;; ----------------------------------------
;; The parser is implemented as a kind of state machine that is driven
@ -525,20 +581,20 @@
;; consumed some digits
(define (read-integer sgn n s start end radix state)
(define (get-n) (* sgn n))
(define (get-n) (* sgn (digits->integer n radix)))
(parse-case
s start end radix => c
[(eof) (finish sgn (get-n) s state)]
[(digit)
(read-integer sgn (+ (* n radix) c) s (fx+ 1 start) end radix state)]
(read-integer sgn (add-digit n c radix) s (fx+ 1 start) end radix state)]
[(#\.)
(read-decimal sgn n 0 s (fx+ 1 start) end radix (set-exactness state 'approx))]
(read-decimal sgn (digits->integer n radix) 0 s (fx+ 1 start) end radix (set-exactness state 'approx))]
[(#\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T)
(read-exponent sgn (get-n) 0 s (fx+ 1 start) end radix (set-exactness-by-char state c))]
[(#\/)
(read-rational sgn (get-n) #f s (fx+ 1 start) end radix state)]
[(#\#)
(read-approx sgn n 1 #f s (fx+ 1 start) end radix (set-exactness state 'approx))]
(read-approx sgn (digits->integer n radix) 1 #f s (fx+ 1 start) end radix (set-exactness state 'approx))]
[(#\+ #\-)
(read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)]
[(#\@)
@ -551,11 +607,11 @@
;; consumed digits and "."
(define (read-decimal sgn n exp s start end radix state)
(define (get-n) (if n
(lazy-number (* sgn n) radix (- exp))
(lazy-number (* sgn (digits->integer n radix)) radix (- exp))
(bad-no-digits "." s state)))
(parse-case
s start end radix => c
[(eof) (or (and n (fast-inexact state sgn n radix 0 -1 exp))
[(eof) (or (and n (fast-inexact state sgn (digits->integer n radix) radix 0 -1 exp))
(maybe (get-n)
(lambda (n)
(finish sgn n s state))))]
@ -567,18 +623,18 @@
;; avoid extra work when ".0" is used to get an inexact zero
(read-decimal sgn (or n 0) exp s next end radix state)]
[else
(read-decimal sgn (+ (* (or n 0) radix) c) (fx+ 1 exp) s (fx+ 1 start) end radix state)])]
(read-decimal sgn (add-digit (or n 0) c radix) (fx+ 1 exp) s (fx+ 1 start) end radix state)])]
[(#\.)
(bad-misplaced "." s state)]
[(#\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T)
(if n
(read-exponent sgn (* sgn n) (- exp) s (fx+ 1 start) end radix (set-exactness-by-char state c))
(read-exponent sgn (* sgn (digits->integer n radix)) (- exp) s (fx+ 1 start) end radix (set-exactness-by-char state c))
(bad-no-digits "." s state))]
[(#\/)
(bad-mixed-decimal-fraction s state)]
[(#\#)
(if n
(read-approx sgn n (fx- 0 exp) #t s (fx+ 1 start) end radix state)
(read-approx sgn (digits->integer n radix) (fx- 0 exp) #t s (fx+ 1 start) end radix state)
(bad-misplaced "#" s state))]
[(#\+ #\-)
(if n
@ -646,18 +702,18 @@
;; consumed digits and "e" (or similar) and "+" or "-" (if any) and maybe digits
(define (read-signed-exponent sgn sgn-n exp sgn2 exp2 s start end radix state)
(define (get-n) (if exp2
(lazy-number sgn-n radix (+ exp (* sgn2 exp2)))
(lazy-number sgn-n radix (+ exp (* sgn2 (digits->integer exp2 radix))))
(fail state "empty exponent `~.a`" s)))
(parse-case
s start end radix => c
[(eof) (or (and exp2
(number? sgn-n)
(fast-inexact state (if (eqv? sgn-n 0) sgn 1) sgn-n radix exp sgn2 exp2))
(fast-inexact state (if (eqv? sgn-n 0) sgn 1) sgn-n radix exp sgn2 (digits->integer exp2 radix)))
(maybe (get-n)
(lambda (n)
(finish sgn n s state))))]
[(digit)
(define new-exp2 (+ (if exp2 (* exp2 radix) 0) c))
(define new-exp2 (add-digit (or exp2 0) c radix))
(read-signed-exponent sgn sgn-n exp sgn2 new-exp2 s (fx+ 1 start) end radix state)]
[(#\+ #\-)
(maybe (get-n)
@ -728,7 +784,7 @@
;; consumed digits and "/"
(define (read-rational sgn sgn-n d s start end radix state)
(define (get-n) (if d
(lazy-divide sgn-n d 'exact)
(lazy-divide sgn-n (digits->integer d radix) 'exact)
(bad-no-digits "/" s state)))
(parse-case
s start end radix => c
@ -737,12 +793,12 @@
(lambda (n)
(finish sgn n s state)))]
[(digit)
(read-rational sgn sgn-n (+ (if d (* d radix) 0) c) s (fx+ 1 start) end radix state)]
(read-rational sgn sgn-n (add-digit (or d 0) c radix) s (fx+ 1 start) end radix state)]
[(#\.)
(bad-mixed-decimal-fraction s state)]
[(#\#)
(if d
(read-denom-approx sgn sgn-n d 1 s (fx+ 1 start) end radix (set-exactness state 'approx))
(read-denom-approx sgn sgn-n (digits->integer d radix) 1 s (fx+ 1 start) end radix (set-exactness state 'approx))
(bad-misplaced "#" s state))]
[(#\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T)
(maybe (get-n)
@ -827,6 +883,12 @@
(module+ test
(require (only-in racket/base
[string->number racket:string->number]))
(let ([s (make-string 1000000 #\9)])
(unless (equal? (time (string->number s))
(sub1 (expt 10 1000000)))
(error 'fail "large number")))
(define (try s)
(define expect (racket:string->number s 10 'read 'decimal-as-inexact))
(define got (string->number s 10 'read 'decimal-as-inexact))