diff --git a/pkgs/racket-test-core/tests/racket/numstrs.rktl b/pkgs/racket-test-core/tests/racket/numstrs.rktl index e42146959a..2c01b15fb5 100644 --- a/pkgs/racket-test-core/tests/racket/numstrs.rktl +++ b/pkgs/racket-test-core/tests/racket/numstrs.rktl @@ -76,8 +76,10 @@ (5e-5 "#i1/2e-4") (0.5 "#i1/2") (1/2 "#e1/2") - (0.5 "#i0.5") + (0.5 "#i0.5") (1/2 "#e0.5") + (0.5 "+.5") + (-0.5 "-.5") (1/20 "#e0.5e-1") (1/20 "#e0.005e1") (1.0+0.5i "1+0.5i") @@ -120,8 +122,8 @@ (-inf.0 "-1/0#") (DBZ "1#/0") (DBZ "-1#/0") - (+inf.0 "#i1#/0") - (-inf.0 "#i-1#/0") + (DBZ "#i1#/0") + (DBZ "#i-1#/0") (NOE "#e+inf.0") (NOE "#e-inf.0") (NOE "#e+nan.0") @@ -216,6 +218,23 @@ (DBZ "5@1/0") (DBZ "1/0@5") (DBZ "1/0e2") + (DBZ "#i1/0") + (DBZ "#i5+1/0i") + (DBZ "#i1/0+5i") + (DBZ "#i5@1/0") + (DBZ "#i1/0@5") + (DBZ "#i1/0e2") + (5+inf.0i "5+1/0#i") + (+inf.0+5i "1/0#+5i") + (+nan.0+nan.0i "5@1/0#") + (+inf.0-inf.0i "1/0#@5") + (DBZ "#i1/0e2") + (#f "1/#e2") + (#f "5+1/#i") + (#f "1/#+5i") + (#f "5@1/#") + (#f "1/#@5") + (#f "1/#e2") (#f "1/0+hi") (#f "x+1/0i") (+nan.0+1i "+nan.0+1i") @@ -265,6 +284,9 @@ (DBZ "+inf.0+1/0i") (DBZ "1/0@+inf.0") (DBZ "+inf.0@1/0") + (DBZ "#i+inf.0+1/0i") + (DBZ "#i1/0@+inf.0") + (DBZ "#i+inf.0@1/0") (#f "1e1/0") (#f "011111122222222223333333333444444x") (#f "t") @@ -279,4 +301,5 @@ (#f ".#e1") (#f "/2") (#f "-#/2") - (X "#/2"))) + (X "#/2") + (#f "2+4ix"))) diff --git a/pkgs/racket-test-core/tests/racket/read.rktl b/pkgs/racket-test-core/tests/racket/read.rktl index fc93fc2999..4c18c4df28 100644 --- a/pkgs/racket-test-core/tests/racket/read.rktl +++ b/pkgs/racket-test-core/tests/racket/read.rktl @@ -616,7 +616,7 @@ (string-append "\\" (cadar l)) (cadar l)) (loop (cdr l))] - [else + [else (test-write-sym (cadar l) (cadar l) (cadar l)) (loop (cdr l))])) @@ -1441,6 +1441,5 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(report-errs) - +;; readtable has `report-errs`: (load-relative "readtable.rktl") diff --git a/racket/src/expander/read/number.rkt b/racket/src/expander/read/number.rkt index 98c2ded502..42c56db051 100644 --- a/racket/src/expander/read/number.rkt +++ b/racket/src/expander/read/number.rkt @@ -2,23 +2,21 @@ (require racket/private/check racket/fixnum racket/extflonum - ;; Call the host `string->number` function only - ;; on valid fixnum, bignum, {single-,double-,ext}flonum - ;; representations that contain digits, possibly a - ;; leading sign, possibly a `.`, and possibly an - ;; exponent marker - (prefix-in host: "../host/string-to-number.rkt") - "parameter.rkt") + "parse-case.rkt" + "parameter.rkt" + ;; Used only to coerce strings to extflonums + ;; when extflonums are not fully suported: + (prefix-in host: "../host/string-to-number.rkt")) (provide string->number unchecked-string->number) ;; The `string->number` parser is responsible for handling Racket's ;; elaborate number syntax (mostly inherited from Scheme). It relies -;; on a host-system `string->number` that can handle well-formed -;; fixnum, bignum, and {double-,single-,extfl}flonum strings for a -;; given radix in the range [2,16]. Otherwise, the parser here -;; performs all checking that reader needs. +;; on a host-system `string->number` only for generating +;; psuedo-extflonums when flonums aren't really supported. Otherwise, +;; the parser here performs all checking and arithmetic that the +;; reader needs. (define/who (string->number s [radix 10] @@ -47,15 +45,343 @@ decimal-mode convert-mode)) +;; ---------------------------------------- + +(struct parse-state (exactness ; see below + convert-mode ; 'number-or-false, 'read, or 'must-read + fst ; rect-prefix, polar-prefix, '+/- if started with sign, or #f + other-exactness) ; exactness to use for the imag part or saved real part + #:authentic) + +;; `sgn/z` records a sign in case `n` is zero +(struct rect-prefix (sgn/z n) #:authentic) +(struct polar-prefix (sgn/z n) #:authentic) + +;; Exactness state is one of +;; - 'exact ; found "#e" +;; - 'inexact ; found "#i" +;; - 'decimal-as-exact +;; - 'decimal-as-inexact +;; - 'approx ; => was 'decimal-as-inexact and found "." or "#" +;; - 'single ; => was 'decimal-as-inexact and found "f"/"s" +;; - 'double ; => was 'decimal-as-inexact and found "e"/"d"/"x" +;; - 'extflonum ; => was 'decimal-as-inexact and found "t" +;; - 'extflonum->inexact ; => was 'inexact and found "t" +;; - 'extflonum->exact ; => was 'exact and found "t" + +(define (init-state exactness convert-mode fst) + (parse-state exactness convert-mode fst exactness)) + +(define (state-has-first-half? state) + (define fst (parse-state-fst state)) + (and fst (not (eq? fst '+/-)))) + +(define (state-set-first-half state fst) + (struct-copy parse-state state + [fst fst] + [exactness (parse-state-other-exactness state)] + [other-exactness (parse-state-exactness state)])) + +(define (state-first-half state) + (init-state (parse-state-other-exactness state) + (parse-state-convert-mode state) + #f)) + +(define (state-second-half state) + (init-state (parse-state-exactness state) + (parse-state-convert-mode state) + #f)) + +;; ---------------------------------------- + ;; When parsing fails, either return an error string or #f. An error ;; string is reported only in 'read mode and when if we're somehow -;; onligated to parse as a number, such as after `#i`. -(define-syntax-rule (fail mode msg arg ...) +;; onligated to parse as a number, such as after `#i`. As a +;; convenience, `state` can be just a convert-mode symbol. +(define-syntax-rule (fail state msg arg ...) (cond - [(eq? mode 'must-read) + [(eq? (state->convert-mode state) 'must-read) (format msg arg ...)] [else #f])) +(define (state->convert-mode state) + (if (parse-state? state) (parse-state-convert-mode state) state)) + +(define (state->dbz-convert-mode state) + (define convert-mode (parse-state-convert-mode state)) + (if (eq? convert-mode 'read) + 'must-read + convert-mode)) + +(define (bad-digit c s state) + (cond + [(char=? c #\nul) + (fail state "nul character in `~.a`" s)] + [else + (fail state "bad digit `~a`" c)])) + +(define (bad-mixed-decimal-fraction s state) + (fail state "decimal points and fractions cannot be mixed in `~.a`" s)) + +(define (bad-misplaced what s state) + (fail state "misplaced `~a` in `~.a`" what s)) + +(define (bad-no-digits after s state) + (fail state "missing digits after `~a` in `~.a`" after s)) + +(define (bad-extflonum-for-complex i s state) + (fail state "cannot combine extflonum `~a` into a complex number" i)) + +;; For chaining a potentially failing parse/conversion with more: +(define-syntax-rule (maybe e k) + (let ([v e]) + (if (or (not v) (string? v)) + v + (k v)))) + +;; ---------------------------------------- + +;; Lazy exponentiation and devision lets us avoid +;; extremely large bignums when we're trying to +;; compute an inexact number that will just be +;; infinity +(struct lazy-expt (n radix exp) + #:authentic) +(struct lazy-rational (n d) + #:authentic) + +(define (lazy-number n radix exp) + (cond + [(eq? n 'dbz) n] + [(eq? n 'dbz!) n] + [else + (if (and (exp . < . 30) + (exp . > . -30)) + (* n (expt radix exp)) + (lazy-expt n radix exp))])) + +(define (lazy-divide n d d-exactness) + (cond + [(eqv? d 0) (if (eq? d-exactness 'exact) + 'dbz! + 'dbz)] + [(or (lazy-expt? n) + (lazy-expt? d)) + (lazy-rational n d)] + [else (/ n d)])) + +(define (simplify-lazy-divide n0) + (cond + [(lazy-rational? n0) + (define n (lazy-rational-n n0)) + (define d (lazy-rational-d n0)) + (define n-n (if (lazy-expt? n) (lazy-expt-n n) n)) + (define n-exp (if (lazy-expt? n) (lazy-expt-exp n) 0)) + (define d-n (if (lazy-expt? d) (lazy-expt-n d) d)) + (define d-exp (if (lazy-expt? d) (lazy-expt-exp d) 0)) + (define radix (if (lazy-expt? n) (lazy-expt-radix n) (lazy-expt-radix d))) + (lazy-number (/ n-n d-n) radix (- n-exp d-exp))] + [else n0])) + +(define (force-lazy-exact n0 state s) + (define n (simplify-lazy-divide n0)) + (cond + [(or (eq? n 'dbz) (eq? n 'dbz!)) + (fail (state->dbz-convert-mode state) "division by zero in `~.a`" s)] + [(lazy-expt? n) + (* (lazy-expt-n n) (expt (lazy-expt-radix n) (lazy-expt-exp n)))] + [else n])) + +(define (force-lazy-inexact sgn/z n0 state s [precision 2048]) + (define n1 (simplify-lazy-divide n0)) + (cond + [(eq? n0 'dbz) (if (fx= sgn/z -1) -inf.0 +inf.0)] + [(eq? n0 'dbz!) + (fail (state->dbz-convert-mode state) "division by zero in `~.a`" s)] + [(lazy-expt? n1) + (define n (lazy-expt-n n1)) + (define exp (lazy-expt-exp n1)) + (define radix (lazy-expt-radix n1)) + (define approx-expt (+ (/ (if (integer? n) + (integer-length n) + (- (integer-length (numerator n)) + (integer-length (denominator n)))) + (log radix 2)) + exp)) + (cond + [(eqv? n 0) (if (fx= sgn/z -1) (- 0.0) 0.0)] + [(approx-expt . > . precision) +inf.0] + [(approx-expt . < . (- precision)) (if (fx= sgn/z -1) (- 0.0) 0.0)] + [else + (* n (expt radix exp))])] + [(eqv? n1 0) (if (fx= sgn/z -1) (- 0.0) 0.0)] + [else n1])) + +(define (fast-inexact state sgn n radix exp sgn2 exp2) + (case (parse-state-exactness state) + [(double approx) + (cond + [(state-has-first-half? state) #f] + [(eqv? n 0) (if (fx= sgn 1) 0.0 (- 0.0))] + [(and (fixnum? n) + ((integer-length n) . < . 50)) + ;; No loss of precision in mantissa from early flonum conversion + (let ([exp (+ exp (* sgn2 exp2))] + [m (fx->fl (if (fx= sgn -1) + (fx- 0 n) + n))] + [radix (if (fx= radix 10) + 10.0 + (fx->fl radix))]) + (cond + [(eqv? exp 0) m] + [(exp . < . 0) (/ m (expt radix (- exp)))] + [else (* m (expt radix exp))]))] + [else #f])] + [else #f])) + +;; The `sgn/z` argument lets us produce -0.0 instead of 0.0 as needed +;; when converting an exact zero to inexact. That is, the sign is `-1` +;; when the input has a literal "-", but it's only used when `n` is 0. +(define (finish sgn/z n s state) + (define fst (parse-state-fst state)) + (cond + [(or (not fst) (eq? fst '+/-)) + (case (parse-state-exactness state) + [(single) + (maybe (force-lazy-inexact sgn/z n state s) + (lambda (r) + (real->single-flonum r)))] + [(exact) + (case n + [(+inf.0 -inf.0 +nan.0) + (fail state "no exact representation for ~a" n)] + [else + (maybe (force-lazy-exact n state s) + (lambda (r) (inexact->exact r)))])] + [(extended) + (cond + [(eq? (parse-state-convert-mode state) 'number-or-false) + #f] + [(extflonum-available?) + (maybe (force-lazy-inexact sgn/z n state s 32768) + (lambda (r) + (real->extfl r)))] + [else + (host:string->number s 10 'read)])] + [(double inexact approx) + (maybe (force-lazy-inexact sgn/z n state s) + (lambda (r0) + (exact->inexact r0)))] + [(extflonum->inexact) + (fail state "cannot convert extflonum to inexact in `~a`" s)] + [(extflonum->exact) + (fail state "cannot convert extflonum to exact in `~a`" s)] + [else (force-lazy-exact n state s)])] + [(polar-prefix? fst) + (define m (finish (polar-prefix-sgn/z fst) (polar-prefix-n fst) s (state-first-half state))) + (define a (finish sgn/z n s (state-second-half state))) + ;; extflonum errors take precedence over errors like divide-by-zero + (cond + [(extflonum? m) + (bad-extflonum-for-complex m s state)] + [(extflonum? a) + (bad-extflonum-for-complex a s state)] + [else + (maybe m + (lambda (m) + (maybe a + (lambda (a) + (define cn (make-polar m a)) + (case (parse-state-exactness state) + [(exact) (inexact->exact cn)] + [else cn])))))])] + [fst (fail state "missing `i` for complex number in `~.a`" s)])) + +;; Called when we find an "i" that might be at the end of the input +(define (finish-imaginary sgn/z n s start end state) + (define fst (parse-state-fst state)) + (cond + [(and (eq? fst '+/-) + (fx= start end)) + ;; Just an imaginary part, ok since the input started "+" or "-" + (maybe (finish sgn/z n s state) + (lambda (i) + (cond + [(extflonum? i) + (bad-extflonum-for-complex i s state)] + [else + (define zero + (case (parse-state-other-exactness state) + [(inexact) 0.0] + [else 0])) + (make-rectangular zero i)])))] + [(and (rect-prefix? fst) + (fx= start end)) + (define r (finish (rect-prefix-sgn/z fst) (rect-prefix-n fst) s (state-first-half state))) + (define i (finish sgn/z n s (state-second-half state))) + ;; extflonum errors take precedence over other errors (such as divide-by-zero) + (cond + [(extflonum? r) + (bad-extflonum-for-complex r s state)] + [(extflonum? i) + (bad-extflonum-for-complex r i state)] + [else + (maybe r + (lambda (r) + (maybe i + (lambda (i) + (make-rectangular r i)))))])] + [else + (bad-misplaced "i" s state)])) + +;; Given a current exactness and an inferred exactness, combine the +;; two specifications +(define (set-exactness state new-exactness #:override? [override? #f]) + (define exactness (parse-state-exactness state)) + (define result-exactness + (case new-exactness + [(single double) + (case exactness + [(exact) 'exact] + [(decimal-as-exact) (if override? + new-exactness + 'decimal-as-exact)] + [else new-exactness])] + [(approx) + (case exactness + [(exact inexact decimal-as-exact) exactness] + [else new-exactness])] + [(extended) + ;; extended mode always overrides + (case exactness + [(inexact) 'extflonum->inexact] + [(exact) 'extflonum->exact] + [else 'extended])] + [else new-exactness])) + (if (eq? exactness result-exactness) + state + (struct-copy parse-state state + [exactness result-exactness]))) + +(define (set-exactness-by-char state c #:override? [override? #f]) + (set-exactness + state + (case c + [(#\e #\E #\d #\D #\l #\L #\0) 'double] + [(#\f #\F #\s #\S) 'single] + [(#\t #\T) 'extended]) + #:override? override?)) + +;; ---------------------------------------- + +;; The parser is implemented as a kind of state machine that is driven +;; by the next input character. The current function mostly represents +;; the state. Some state is in other arguments -- especially the +;; `state` argument, obviously --- to avoid duplicating all functions +;; for similar states, such as parsing a number in the real or +;; imaginary position of a complex number. + ;; The `convert-mode` argument here can be 'number-or-false, 'read, or ;; 'must-read, where 'must-read reports an error on parsing failure ;; instead of returning #f. At this level, we mostly detect the @@ -64,703 +390,396 @@ (define (do-string->number s start end radix #:radix-set? radix-set? exactness ; 'inexact, 'exact, 'decimal-as-inexact, or 'decimal-as-exact - #:in-complex [in-complex #f] ; #f, 'i, or '@ convert-mode) - (cond - [(fx= start end) - (fail convert-mode "no digits")] - [else - (define c (string-ref s start)) - (cond - ;; `#e`, `#x`, etc. - [(char=? #\# c) - (define next (fx+ 1 start)) - (cond - [(fx= next end) - (fail convert-mode "no character after `#` indicator in `~.a`" s)] - [else - (define i (string-ref s next)) + (parse-case + s start end radix => c + [(eof) + (fail convert-mode "no digits")] + [(digit) + (read-integer 1 c s (fx+ 1 start) end radix (init-state exactness convert-mode #f))] + [(#\#) + (define next (fx+ 1 start)) + (parse-case + s next end radix => i + [(eof) + (fail convert-mode "no character after `#` indicator in `~.a`" s)] + [(#\e #\E #\i #\I) + (cond + [(or (eq? exactness 'exact) (eq? exactness 'inexact)) + (fail convert-mode "misplaced exactness specification at `~.a`" (substring s start end))] + [else + (do-string->number s (fx+ 1 next) end + radix #:radix-set? radix-set? + (if (or (char=? i #\e) (char=? i #\E)) 'exact 'inexact) + (if (eq? convert-mode 'read) 'must-read convert-mode))])] + [(#\b #\B #\o #\O #\d #\D #\x #\X) + (cond + [radix-set? + (fail convert-mode "misplaced radix specification at `~.a`" (substring s start end))] + [else + (define radix (case i - [(#\e #\E #\i #\I) - (cond - [(or (exactness-set? exactness) in-complex) - (fail convert-mode "misplaced exactness specification at `~.a`" (substring s start end))] - [else - (do-string->number s (fx+ 1 next) end - radix #:radix-set? radix-set? - (if (or (char=? i #\e) (char=? i #\E)) 'exact 'inexact) - (if (eq? convert-mode 'read) 'must-read convert-mode))])] - [(#\b #\B #\o #\O #\d #\D #\x #\X) - (cond - [(or radix-set? in-complex) - (fail convert-mode "misplaced radix specification at `~.a`" (substring s start end))] - [else - (define radix - (case i - [(#\b #\B) 2] - [(#\o #\O) 8] - [(#\d #\D) 10] - [else 16])) - (do-string->number s (fx+ 1 next) end - radix #:radix-set? #t - exactness - (if (eq? convert-mode 'read) 'must-read convert-mode))])] - [else - ;; The reader always complains about a bad leading `#` - (fail (read-complains convert-mode) "bad `#` indicator `~a` at `~.a`" i (substring s start end))])])] - ;; +inf.0, etc. - [(and (char-sign? c) - (read-special-number s start end convert-mode)) - => - (lambda (v) - (cond - [(eq? exactness 'exact) - (fail convert-mode "no exact representation for `~a`" v)] - [else v]))] - ;; +inf.0+...i, etc. - [(and (char-sign? c) - (not in-complex) - ((fx- end start) . fx> . 7) - (char=? #\i (string-ref s (fx- end 1))) - (char-sign? (string-ref s 6)) - (read-special-number s start (fx+ start 6) convert-mode)) - => - (lambda (v) - (read-for-special-compound s (fx+ start 6) (fx- end 1) - radix - exactness - convert-mode - #:in-complex 'i - v (lambda (v v2) - (make-rectangular v v2))))] - ;; ...+inf.0i, etc. - [(and (not in-complex) - ((fx- end start) . fx>= . 7) ; allow `+inf.0i` - (char=? #\i (string-ref s (fx- end 1))) - (char-sign? (string-ref s (fx- end 7))) - (read-special-number s (fx- end 7) (fx- end 1) convert-mode)) - => - (lambda (v2) - (cond - [(and (fx= start (fx- end 7)) - (not (extflonum? v2))) - (make-rectangular 0 v2)] - [else - (read-for-special-compound s start (fx- end 7) - radix - exactness - convert-mode - #:in-complex 'i - #:reading-first? #t - v2 (lambda (v2 v) - (make-rectangular v v2)))]))] - ;; +inf.0@..., etc. - [(and (char-sign? c) - (not in-complex) - ((fx- end start) . fx> . 7) - (char=? #\@ (string-ref s (fx+ start 6))) - (read-special-number s start (fx+ start 6) convert-mode)) - => - (lambda (v) - (read-for-special-compound s (fx+ start 7) end - radix - exactness - convert-mode - #:in-complex '@ - v (lambda (v v2) - (make-polar v v2))))] - ;; ...@+inf.0, etc. - [(and (not in-complex) - ((fx- end start) . fx> . 7) - (char=? #\@ (string-ref s (fx- end 7))) - (read-special-number s (fx- end 6) end convert-mode)) - => - (lambda (v2) - (read-for-special-compound s start (fx- end 7) - radix - exactness - convert-mode - #:in-complex '@ - #:reading-first? #t - v2 (lambda (v2 v) - (make-polar v v2))))] - [else - (do-string->non-special-number s start end - radix #:radix-set? radix-set? - exactness - #:in-complex in-complex - convert-mode)])])) + [(#\b #\B) 2] + [(#\o #\O) 8] + [(#\d #\D) 10] + [else 16])) + (do-string->number s (fx+ 1 next) end + radix #:radix-set? #t + exactness + (if (eq? convert-mode 'read) 'must-read convert-mode))])] + [else + ;; The reader always complains about a bad leading `#` + (fail (if (eq? convert-mode 'read) 'must-read convert-mode) + "bad `#` indicator `~a` at `~.a`" i (substring s start end))])] + [(#\+) + (read-signed 1 s (fx+ 1 start) end radix (init-state exactness convert-mode '+/-))] + [(#\-) + (read-signed -1 s (fx+ 1 start) end radix (init-state exactness convert-mode '+/-))] + [(#\.) + (read-decimal 1 #f 0 s (fx+ 1 start) end radix (set-exactness (init-state exactness convert-mode #f) 'approx))] + [else + (bad-digit c s convert-mode)])) -(define (do-string->non-special-number s start end - radix #:radix-set? radix-set? - exactness - #:in-complex [in-complex #f] - convert-mode) - ;; Look for `@`, `i`, `+`/`-`, and exponent markers like `e`. - ;; Some of those can be used together, but we detect impossible - ;; combinations here and complain. For example `+` that's not - ;; after an exponential marker cannot appear twice, unless the - ;; the two are separated by `@` or the second eventually supports - ;; an ending `i`. Sometimes we can complain right away, and other - ;; times we collect positions to complain at the end, which as - ;; when an extra sign appears after a `.` or `/`. - (let loop ([i start] [any-digits? #f] [any-hashes? #f] [i-pos #f] [@-pos #f] - [sign-pos #f] [dot-pos #f] [slash-pos #f] [exp-pos #f] - [must-i? #f]) +;; consumed a "+" or "-" +(define (read-signed sgn s start end radix state) + (parse-case + s start end radix => c + [(eof) (fail state "no digits in `~.a`" s)] + [(digit) + (read-integer sgn c s (fx+ 1 start) end radix state)] + [(#\.) + (read-decimal sgn #f 0 s (fx+ 1 start) end radix (set-exactness state 'approx))] + [(#\i #\I) + ;; maybe "[+-]inf.0" + (parse-case + s (fx+ 1 start) end radix => c2 + [(eof) + (finish-imaginary sgn sgn s (fx+ 1 start) end state)] + [(#\n #\N) + (read-infinity sgn c s (fx+ 2 start) end radix state)] + [else (bad-digit c s state)])] + [(#\n #\N) + ;; maybe "[+-]nan.0" + (read-nan c s (fx+ 1 start) end radix state)] + [else + (bad-digit c s state)])) + +;; consumed some digits +(define (read-integer sgn n s start end radix state) + (define (get-n) (* sgn n)) + (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-decimal sgn n 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-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)] + [(#\@) + (read-polar sgn (get-n) s (fx+ 1 start) end radix state)] + [(#\i) + (finish-imaginary sgn (get-n) s (fx+ 1 start) end state)] + [else + (bad-digit c s state)])) + +;; 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)) + (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)) + (maybe (get-n) + (lambda (n) + (finish sgn n s state))))] + [(digit) + (define next (fx+ 1 start)) (cond - [(fx= i end) - ;; We've finished looking, so dispatch on the kind of number parsing - ;; based on found `@`, etc. - ;; If we saw `@`, then we discarded other positions at that point. - ;; If we saw `i` at the end, then we discarded other positions except `sign-pos`. - ;; If we saw `.`, then we discarded earlier `slash-pos` and `exp-pos` or complained. - ;; If we saw `/`, then we discarded earlier `dot-pos` and `exp-pos` or complained. - ;; If we saw `+` or `-`, then we discarded earlier `exp-pos`. - (cond - [(and (not any-digits?) - ;; A number like `+i` can work with no digits - (not i-pos)) - (fail convert-mode "no digits in `~.a`" (substring s start end))] - [(and must-i? (not i-pos)) - (fail convert-mode "too many signs in `~.a`" (substring s start end))] - [(and sign-pos - (or (and dot-pos (dot-pos . fx< . sign-pos)) - (and slash-pos (slash-pos . fx< . sign-pos)))) - (fail convert-mode "misplaced sign in `~.a`" (substring s start end))] - [i-pos - (string->complex-number s start sign-pos sign-pos (fx- end 1) - i-pos sign-pos - radix #:radix-set? radix-set? - exactness - #:in-complex 'i - convert-mode)] - [@-pos - (string->complex-number s start @-pos (fx+ 1 @-pos) end - i-pos sign-pos - radix #:radix-set? radix-set? - exactness - #:in-complex '@ - convert-mode)] - [else - (string->real-number s start end - dot-pos slash-pos exp-pos - any-hashes? - radix - exactness - convert-mode)])] + [(and (eqv? c #\0) + (fx= next end)) + ;; 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 - (define c (string-ref s i)) - (cond - [(digit? c radix) - (loop (fx+ 1 i) #t any-hashes? i-pos @-pos - sign-pos dot-pos slash-pos exp-pos - must-i?)] - [(char=? c #\#) ; treat like a digit - (loop (fx+ 1 i) #t #t i-pos @-pos - sign-pos dot-pos slash-pos exp-pos - must-i?)] - [(char-sign? c) - (cond - [(and sign-pos must-i?) - (fail convert-mode "too many signs in `~.a`" (substring s start end))] - [else - (loop (fx+ 1 i) any-digits? any-hashes? i-pos @-pos - i dot-pos slash-pos #f - ;; must be complex if sign isn't at start - (and (fx> i start) (or (not @-pos) (fx> i (fx+ 1 @-pos)))))])] - [(char=? c #\.) - (cond - [(or (and exp-pos (or (not sign-pos) (exp-pos . fx> . sign-pos))) - (and dot-pos (or (not sign-pos) (dot-pos . fx> . sign-pos)))) - (fail convert-mode "misplaced `.` in `~.a`" (substring s start end))] - [(and slash-pos (or (not sign-pos) (slash-pos . fx> . sign-pos))) - (fail convert-mode "decimal points and fractions cannot be mixed `~.a`" (substring s start end))] - [else - (loop (fx+ 1 i) any-digits? any-hashes? i-pos @-pos - sign-pos i #f #f - must-i?)])] - [(char=? c #\/) - (cond - [(and dot-pos (or (not sign-pos) (dot-pos . fx> . sign-pos))) - (fail convert-mode "decimal points and fractions cannot be mixed `~.a`" (substring s start end))] - [(or (and exp-pos (or (not sign-pos) (exp-pos . fx> . sign-pos))) - (and slash-pos (or (not sign-pos) (slash-pos . fx> . sign-pos)))) - (fail convert-mode "misplaced `/` in `~.a`" (substring s start end))] - [else - (loop (fx+ 1 i) any-digits? any-hashes? i-pos @-pos - sign-pos #f i #f - must-i?)])] - [(or (char=? c #\e) (char=? c #\E) - (char=? c #\f) (char=? c #\F) - (char=? c #\d) (char=? c #\D) - (char=? c #\s) (char=? c #\S) - (char=? c #\l) (char=? c #\L) - (char=? c #\t) (char=? c #\T)) - (cond - [exp-pos - (fail convert-mode "misplaced `~a` in `~.a`" c (substring s start end))] - ;; Don't count a sign in something like 1e+2 as `sign-pos` - [(and ((fx+ 1 i) . fx< . end) - (char-sign? (string-ref s (fx+ 1 i)))) - (loop (fx+ i 2) any-digits? any-hashes? i-pos @-pos - sign-pos dot-pos slash-pos (or exp-pos i) - must-i?)] - [else - (loop (fx+ i 1) any-digits? any-hashes? i-pos @-pos - sign-pos dot-pos slash-pos (or exp-pos i) - must-i?)])] - [(char=? c #\@) - (cond - [(eq? in-complex 'i) - (fail convert-mode "cannot mix `@` and `i` in `~.a`" (substring s start end))] - [(or @-pos (eq? in-complex '@)) - (fail convert-mode "too many `@`s in `~.a`" (substring s start end))] - [(fx= i start) - (fail convert-mode "`@` cannot be at start in `~.a`" (substring s start end))] - [must-i? - (fail convert-mode "too many signs in `~.a`" (substring s start end))] - [else - (loop (fx+ 1 i) any-digits? any-hashes? i-pos i - #f #f #f #f - must-i?)])] - [(and (or (char=? c #\i) (char=? c #\I)) - sign-pos) - (cond - [(or @-pos (eq? in-complex '@)) - (fail convert-mode "cannot mix `@` and `i` in `~.a`" (substring s start end))] - [(or ((fx+ 1 i) . fx< . end) (eq? in-complex 'i)) - (fail convert-mode "`i` must be at the end in `~.a`" (substring s start end))] - [else - (loop (fx+ 1 i) any-digits? any-hashes? i @-pos - sign-pos #f #f #f - #f)])] - [else - (cond - [(char=? c #\nul) - (fail convert-mode "nul character in `~.a`" s)] - [else - (fail convert-mode "bad digit `~a`" c)])])]))) + (read-decimal sgn (+ (* (or n 0) radix) c) (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)) + (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) + (bad-misplaced "#" s state))] + [(#\+ #\-) + (if n + (read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state) + (bad-no-digits "." s state))] + [(#\@) + (maybe (get-n) + (lambda (n) + (read-polar sgn n s (fx+ 1 start) end radix state)))] + [(#\i) + (maybe (get-n) + (lambda (n) + (finish-imaginary sgn n s (fx+ 1 start) end state)))] + [else + (bad-digit c s state)])) -;; Parse and combine the halves of an impginary number, either -;; in `[+-]i` form or `@` form as -;; indicated by `in-complex` -(define (string->complex-number s start1 end1 start2 end2 - i-pos sign-pos - radix #:radix-set? radix-set? - exactness - #:in-complex in-complex ; 'i or '@ - convert-mode) - (define v1 (cond - [(fx= start1 end1) - ;; The input was "[+-]i", so the real part - ;; is implicitly "0" - (if (eq? exactness 'inexact) - 0.0 - 0)] - [else - (do-string->number s start1 end1 - radix #:radix-set? radix-set? - exactness - #:in-complex in-complex - convert-mode)])) - (define v2 (cond - [(and (eq? in-complex 'i) - (fx= (fx- end2 start2) 1)) - ;; The input ends "[+-]i", so the number is implicitly - ;; "1" - (define neg? (char=? (string-ref s start2) #\-)) - (cond - [(eq? exactness 'inexact) - (if neg? -1.0 1.0)] - [else - (if neg? -1 1)])] - [else - (do-string->number s start2 end2 - radix #:radix-set? radix-set? - exactness - #:in-complex in-complex - convert-mode)])) +;; consumed digits and maybe "." and some "#"s +(define (read-approx sgn n exp saw-.? s start end radix state) + (define (get-n) (lazy-number (* sgn n) radix exp)) + (parse-case + s start end radix => c + [(eof) (finish sgn (get-n) s state)] + [(digit) + (bad-misplaced "#" s state)] + [(#\.) + (if saw-.? + (bad-misplaced "." s state) + (read-approx sgn n exp #t s (fx+ 1 start) end radix state))] + [(#\#) + (read-approx sgn n (if saw-.? exp (fx+ 1 exp)) saw-.? s (fx+ 1 start) end radix state)] + [(#\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T) + (read-exponent sgn (* sgn n) exp s (fx+ 1 start) end radix (set-exactness-by-char state c))] + [(#\/) + (if saw-.? + (bad-mixed-decimal-fraction s state) + (read-rational sgn (get-n) #f s (fx+ 1 start) end radix state))] + [(#\+ #\-) + (read-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)] + [(#\@) + (read-polar sgn (get-n) s (fx+ 1 start) end radix state)] + [(#\i) + (finish-imaginary sgn (get-n) s (fx+ 1 start) end state)] + [else + (bad-digit c s state)])) + +;; consumed digits and "e" (or similar) +(define (read-exponent sgn sgn-n exp s start end radix state) + (parse-case + s start end radix => c + [(eof #\@) (fail state "empty exponent `~.a`" s)] + [(digit) + (read-signed-exponent sgn sgn-n exp 1 c s (fx+ 1 start) end radix state)] + [(#\+ #\-) + (define sgn2 (if (eqv? c #\+) +1 -1)) + (read-signed-exponent sgn sgn-n exp sgn2 #f s (fx+ 1 start) end radix state)] + [(#\. #\# #\/ #\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T) + (bad-misplaced c s state)] + [(#\i) + (if (state-has-first-half? state) + (fail state "empty exponent `~.a`" s) + (bad-misplaced "i" s state))] + [else + (bad-digit c s state)])) + +;; 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))) + (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)) + (maybe (get-n) + (lambda (n) + (finish sgn n s state))))] + [(digit) + (define new-exp2 (+ (if exp2 (* exp2 radix) 0) c)) + (read-signed-exponent sgn sgn-n exp sgn2 new-exp2 s (fx+ 1 start) end radix state)] + [(#\+ #\-) + (maybe (get-n) + (lambda (n) + (read-imag c sgn n (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)))] + [(#\. #\# #\/ #\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T) + (bad-misplaced c s state)] + [(#\@) + (maybe (get-n) + (lambda (n) + (read-polar sgn n s (fx+ 1 start) end radix state)))] + [(#\i) + (maybe (get-n) + (lambda (n) + (finish-imaginary sgn n s (fx+ 1 start) end state)))] + [else + (bad-digit c s state)])) + +;; consumed "+in" or "-in" +(define (read-infinity sgn c s start end radix state) + (parse-case* + s start end + [[(#\f #\F) + (#\.) + (#\0 #\f #\t)] + (define n (if (negative? sgn) -inf.0 +inf.0)) + (define new-state (set-exactness-by-char state (string-ref s (fx+ start 2)) + #:override? #t)) + (parse-case + s (fx+ 3 start) end radix => c2 + [(eof) (finish sgn n s new-state)] + [(#\+ #\-) + (read-imag c2 sgn n (if (eqv? c2 #\+) +1 -1) s (fx+ 4 start) end radix new-state)] + [(#\@) + (read-polar sgn n s (fx+ 4 start) end radix new-state)] + [(#\i) + (finish-imaginary sgn n s (fx+ 4 start) end new-state)] + [else + (bad-digit c s state)])] + [else + (bad-digit c s state)])) + +;; consumed "+n" +(define (read-nan c s start end radix state) + (parse-case* + s start end + [[(#\a #\A) + (#\n #\N) + (#\.) + (#\0 #\f #\t)] + (define n +nan.0) + (define new-state (set-exactness-by-char state (string-ref s (fx+ start 3)) + #:override? #t)) + (parse-case + s (fx+ 4 start) end radix => c2 + [(eof) (finish +1 n s new-state)] + [(#\+ #\-) + (read-imag c2 1 n (if (eqv? c2 #\+) +1 -1) s (fx+ 5 start) end radix new-state)] + [(#\@) + (read-polar 1 n s (fx+ 5 start) end radix new-state)] + [(#\i) + (finish-imaginary +1 n s (fx+ 5 start) end new-state)] + [else + (bad-digit c s state)])] + [else + (bad-digit c s state)])) + +;; 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) + (bad-no-digits "/" s state))) + (parse-case + s start end radix => c + [(eof) + (maybe (get-n) + (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)] + [(#\.) + (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)) + (bad-misplaced "#" s state))] + [(#\e #\E #\d #\D #\l #\L #\f #\F #\s #\S #\t #\T) + (maybe (get-n) + (lambda (sgn-n) + (read-exponent sgn sgn-n 0 s (fx+ 1 start) end radix (set-exactness-by-char state c))))] + [(#\/) + (bad-misplaced "/" s state)] + [(#\+ #\-) + (maybe (get-n) + (lambda (n) + (read-imag c sgn n (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)))] + [(#\@) + (maybe (get-n) + (lambda (n) + (read-polar sgn n s (fx+ 1 start) end radix state)))] + [(#\i) + (maybe (get-n) + (lambda (n) + (finish-imaginary sgn n s (fx+ 1 start) end state)))] + [else + (bad-digit c s state)])) + +;; consumed digits and "/" and digits and "#" +(define (read-denom-approx sgn sgn-n d exp s start end radix state) + (define (get-n) (lazy-divide sgn-n (lazy-number d radix exp) 'approx)) + (parse-case + s start end radix => c + [(eof) (finish sgn (get-n) s state)] + [(#\#) + (read-denom-approx sgn sgn-n d (fx+ 1 exp) s (fx+ 1 start) end radix state)] + [(digit) + (bad-misplaced "#" s state)] + [(#\. #\/) + (bad-misplaced c s state)] + [(#\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-imag c sgn (get-n) (if (eqv? c #\+) +1 -1) s (fx+ 1 start) end radix state)] + [(#\@) + (read-polar sgn (get-n) s (fx+ 1 start) end radix state)] + [(#\i) + (finish-imaginary sgn (get-n) s (fx+ 1 start) end state)] + [else + (bad-digit c s state)])) + +;; consumed "+" or "-" after the number in `real` +(define (read-imag c real-sgn real sgn s start end radix state) (cond - [(or (not v1) (not v2)) - #f] - [(and (or (extflonum? v1) (extflonum? v2)) - (not (eq? convert-mode 'must-read))) - ;; If no 'must-read, then an extflonum-combination - ;; failure hides even a divide-by-zero error - (fail-extflonum convert-mode v1)] - [(string? v1) v1] - [(extflonum? v1) - (fail-extflonum convert-mode v1)] - [(string? v2) v2] - [(extflonum? v2) - (fail-extflonum convert-mode v2)] - [(eq? in-complex 'i) - (make-rectangular v1 v2)] + [(or (state-has-first-half? state) + (eq? 'extended (parse-state-exactness state))) + ;; already parsing a complex number + (bad-misplaced c s state)] [else - (define p (make-polar v1 v2)) - (if (eq? exactness 'exact) - (inexact->exact p) - p)])) + ;; take it from almost the top, pushing the number so far into `state`; + ;; we don't have to start at the very top, because we saw a "+" or "-" + (read-signed sgn s start end radix (state-set-first-half state (rect-prefix real-sgn real)))])) -;; Parse a real number that might be a fraction, have `.`, or have `#`s -(define (string->real-number s start end - dot-pos slash-pos exp-pos - any-hashes? ; can be false-positive - radix - exactness - convert-mode) - ;; Try shortcut of using primitive `string->number`, which should - ;; work on real numbers and extflonums - (define (extfl-mark?) (char=? (char-downcase (string-ref s exp-pos)) #\t)) - (define simple? - (and (not slash-pos) - (or (eq? exactness 'inexact) - (eq? exactness 'decimal-as-inexact) - (and (not dot-pos) (not exp-pos))) - (or (not exp-pos) - (not (eq? convert-mode 'number-or-false)) - (not (extfl-mark?))) - (not (and any-hashes? (hashes? s start end))))) - (define has-sign? (and (end . fx> . start) (char-sign? (string-ref s start)))) +;; consumed "@" after the number in `real` +(define (read-polar real-sgn real s start end radix state) (cond - [(fx= (fx- end start) (fx+ (if dot-pos 1 0) (if exp-pos 1 0) (if has-sign? 1 0))) - (if (fx= end start) - (fail convert-mode "missing digits") - (fail convert-mode "missing digits in `~.a`" (substring s start end)))] - [simple? - (cond - [(and exp-pos (fx= (fx- exp-pos start) - (fx+ (if (and dot-pos (fx< dot-pos exp-pos)) 1 0) - (if has-sign? 1 0)))) - (fail convert-mode "missing digits before exponent marker in `~.a`" (substring s start end))] - [(and exp-pos - (or (fx= exp-pos (fx- end 1)) - (and (fx= exp-pos (fx- end 2)) - (char-sign? (string-ref s (fx- end 1)))))) - (fail convert-mode "missing digits after exponent marker in `~.a`" (substring s start end))] - [else - (define n (host:string->number (maybe-substring s start end) radix - ;; Use 'read mode as needed to enable extflonum results - (if (or (eq? convert-mode 'number-or-false) - (not exp-pos) - (not (extfl-mark?))) - 'number-or-false - 'read))) - (cond - [(or (not n) (string? n)) - (error 'string->number "host `string->number` failed on ~s with radix ~s" (substring s start end) radix)] - [(eq? exactness 'inexact) - (cond - [(extflonum? n) - (fail convert-mode "cannot convert extflonum `~.a` to inexact" (substring s start end))] - [(and (eqv? n 0) - (char=? (string-ref s start) #\-)) - -0.0] - [else - (exact->inexact n)])] - [else n])])] - [exp-pos - (define m-v (string->real-number s start exp-pos - dot-pos slash-pos #f - any-hashes? - radix - 'exact - convert-mode)) - (define e-v (string->exact-integer-number s (fx+ exp-pos 1) end - radix - convert-mode)) - (define (real->precision-inexact r) - (case (string-ref s exp-pos) - [(#\s #\S #\f #\F) (real->single-flonum r)] - [(#\t #\T) - (if (extflonum-available?) - (real->extfl r) - ;; The host `string->number` can make a string-based - ;; representation to preserve the content, if not compute - ;; with it - (host:string->number (replace-hashes s start end) radix 'read))] - [else (real->double-flonum r)])) - (define get-extfl? (extfl-mark?)) - (cond - [(or (not m-v) (not e-v)) #f] - [(string? m-v) m-v] - [(string? e-v) e-v] - [(and (eq? convert-mode 'number-or-false) get-extfl?) - #f] - [(and (or (eq? exactness 'inexact) (eq? exactness 'decimal-as-inexact)) - (let ([m-v-e (/ (- (integer-length (numerator m-v)) - (integer-length (denominator m-v))) - (log radix 2))]) - ((abs (+ e-v m-v-e)) . > . (if get-extfl? (expt 2 15) (expt 2 11))))) - ;; Don't calculate a huge exponential to return a float: - (real->precision-inexact - (cond - [(eqv? m-v 0) (if (char=? (string-ref s start) #\-) - -0.0 - 0.0)] - [(positive? m-v) (if (positive? e-v) - +inf.0 - +0.0)] - [else (if (positive? e-v) - -inf.0 - -0.0)]))] - [(and (exactness-set? exactness) get-extfl?) - (fail convert-mode "cannot convert extflonum `~.a` to ~a" (substring s start end) exactness)] - [else - ;; This calculation would lose precision for floating-point - ;; numbers, but we don't get here for inexact `m-v`: - (define n (* m-v (expt radix e-v))) - (cond - [(and (not get-extfl?) - (or (eq? exactness 'exact) (eq? exactness 'decimal-as-exact))) - n] - [(and (eqv? n 0) - (char=? (string-ref s start) #\-)) - (real->precision-inexact -0.0)] - [else - (real->precision-inexact n)])])] - [slash-pos - ;; the numerator or demoniator doesn't have a decimal - ;; place or exponent marker, but it may have `#`s - (define n-v (string->real-number s start slash-pos - #f #f #f - any-hashes? - radix - 'exact - convert-mode)) - (define d-v (string->real-number s (fx+ 1 slash-pos) end - #f #f #f - any-hashes? - radix - 'exact - convert-mode)) - (define (get-inexact? from-pos) - (or (eq? exactness 'inexact) - (and (not (or (eq? exactness 'exact) - (eq? exactness 'decimal-as-exact))) - (hashes? s from-pos end)))) - (cond - [(or (not n-v) (not d-v)) #f] - [(string? n-v) n-v] - [(string? d-v) d-v] - [(eqv? d-v 0) - (cond - [(get-inexact? (fx+ 1 slash-pos)) - (if (negative? n-v) - -inf.0 - +inf.0)] - [else - ;; The reader always complains about divide-by-zero - (fail (read-complains convert-mode) "division by zero in `~.a`" (substring s start end))])] - [else - (define n (/ n-v d-v)) - (if (get-inexact? start) - (exact->inexact n) - n)])] - ;; We get this far only if the input has `#` or if the input has a - ;; `.` and we want exact + [(or (state-has-first-half? state) + (eq? 'extended (parse-state-exactness state))) + ;; already parsing a complex number + (bad-misplaced "@" s state)] [else - (string->decimal-number s start end - dot-pos - radix - exactness - convert-mode)])) - -;; Parse a number that might have `.` and/or `#` in additon to digits -;; and possibiliy a leading `+` or `-` -(define (string->decimal-number s start end - dot-pos - radix - exactness - convert-mode) - (define get-exact? (or (eq? exactness 'exact) (eq? exactness 'decimal-as-exact))) - (define new-str (make-string (fx- end start (if (and dot-pos get-exact?) 1 0)))) - (let loop ([i (fx- end 1)] [j (fx- (string-length new-str) 1)] [hashes-pos end]) - (cond - [(i . fx< . start) - ;; Convert `new-str` to an integer and finish up - (cond - [(fx= hashes-pos start) - (fail convert-mode "misplaced `#` in `~.a`" (substring s start end))] - [else - (define n (host:string->number new-str radix)) - (cond - [(not n) - (fail-bad-number convert-mode s start end)] - [(not get-exact?) - (if (and (eqv? n 0) - (char=? (string-ref s start) #\-)) - -0.0 - (exact->inexact n))] - [(and dot-pos get-exact?) - (/ n (expt 10 (fx- end dot-pos 1)))] - [else n])])] + ;; take it from the top, pushing the number so far into `state` + (parse-case + s start end radix => c + [(eof) + (bad-misplaced "@" s state)] + [(#\+ #\-) + (define new-state (state-set-first-half state (polar-prefix real-sgn real))) + (read-signed (if (eq? c '#\+) 1 -1) s (fx+ 1 start) end radix new-state)] + [(digit) + (define new-state (state-set-first-half state (polar-prefix real-sgn real))) + (read-integer 1 c s (fx+ 1 start) end radix new-state)] [else - (define c (string-ref s i)) - (cond - [(char=? c #\.) - (cond - [get-exact? - (loop (fx- i 1) j (if (fx= hashes-pos (fx+ 1 i)) i hashes-pos))] - [else - (string-set! new-str j c) - (loop (fx- i 1) (fx- j 1) (if (fx= hashes-pos (fx+ 1 i)) i hashes-pos))])] - [(or (char=? c #\-) (char=? c #\+)) - (string-set! new-str j c) - (loop (fx- i 1) (fx- j 1) (if (fx= hashes-pos (fx+ 1 i)) i hashes-pos))] - [(char=? c #\#) - (cond - [(fx= hashes-pos (fx+ 1 i)) - (string-set! new-str j #\0) - (loop (fx- i 1) (fx- j 1) i)] - [else - (fail convert-mode "misplaced `#` in `~.a`" (substring s start end))])] - [else - (string-set! new-str j c) - (loop (fx- i 1) (fx- j 1) hashes-pos)])]))) - -;; Parse an integer that might have `#` and a leading `+` or `-`, but -;; no other non-digit characters -(define (string->exact-integer-number s start end - radix - convert-mode) - (cond - [(hashes? s start end) - (fail convert-mode "misplaced `#` in `~.a`" (substring s start end))] - [else - (define n (host:string->number (maybe-substring s start end) radix)) - (cond - [(not n) - (fail convert-mode "bad exponent `~.a`" (substring s start end))] - [else n])])) - -;; Try to read as `+inf.0`, etc. -(define (read-special-number s start end convert-mode) - (and - (fx= (fx- end start) 6) - (or (char=? (string-ref s start) #\+) - (char=? (string-ref s start) #\-)) - (or - (and (char=? (char-downcase (string-ref s (fx+ start 1))) #\i) - (char=? (char-downcase (string-ref s (fx+ start 2))) #\n) - (char=? (char-downcase (string-ref s (fx+ start 3))) #\f) - (char=? (char-downcase (string-ref s (fx+ start 4))) #\.) - (or - (and - (char=? (char-downcase (string-ref s (fx+ start 5))) #\0) - (if (char=? (string-ref s start) #\+) - +inf.0 - -inf.0)) - (and - (char=? (char-downcase (string-ref s (fx+ start 5))) #\f) - (if (char=? (string-ref s start) #\+) - +inf.f - -inf.f)) - (and - (char=? (char-downcase (string-ref s (fx+ start 5))) #\t) - (not (eq? convert-mode 'number-or-false)) - (if (char=? (string-ref s start) #\+) - +inf.t - -inf.t)))) - (and (char=? (char-downcase (string-ref s (fx+ start 1))) #\n) - (char=? (char-downcase (string-ref s (fx+ start 2))) #\a) - (char=? (char-downcase (string-ref s (fx+ start 3))) #\n) - (char=? (char-downcase (string-ref s (fx+ start 4))) #\.) - (or (and (char=? (char-downcase (string-ref s (fx+ start 5))) #\0) - +nan.0) - (and (char=? (char-downcase (string-ref s (fx+ start 5))) #\f) - +nan.f) - (and (char=? (char-downcase (string-ref s (fx+ start 5))) #\t) - (not (eq? convert-mode 'number-or-false)) - +nan.t)))))) - -(define (fail-extflonum convert-mode v) - (fail convert-mode "cannot combine extflonum `~a` into complex number" v)) - -;; Read the other half of something like `+inf.0+...i` or `...@-inf.0` -(define (read-for-special-compound s start end - radix - exactness - convert-mode - #:in-complex in-complex - #:reading-first? [reading-first? #f] - v combine) - (cond - [(eq? exactness 'exact) - (fail convert-mode "no exact representation for `~a`" v)] - [(and (extflonum? v) (or (not reading-first?) - ;; If no 'must-read, then an extflonum-combination - ;; failure hides even a divide-by-zero error - (not (eq? convert-mode 'must-read)))) - (fail-extflonum convert-mode v)] - [else - (define v2 - (do-string->number s start end - radix #:radix-set? #t - exactness - #:in-complex in-complex - convert-mode)) - (cond - [(string? v2) v2] - [(not v2) v2] - [(extflonum? v) - (fail-extflonum convert-mode v)] - [else (combine v v2)])])) - -(define (hashes? s start end) - (for/or ([c (in-string s start end)]) - (char=? c #\#))) - -(define (replace-hashes s start end) - (define new-s (make-string (fx- end start))) - (for ([c (in-string s start end)] - [i (in-naturals)]) - (if (char=? c #\#) - (string-set! new-s i #\0) - (string-set! new-s i c))) - new-s) - -(define (maybe-substring s start end) - (if (and (fx= 0 start) - (fx= end (string-length s))) - s - (substring s start end))) - -(define (exactness-set? exactness) - (or (eq? exactness 'exact) (eq? exactness 'inexact))) - -(define (char-sign? c) - (or (char=? c #\-) (char=? c #\+))) - -(define (digit? c radix) - (define v (char->integer c)) - (or (and (v . fx>= . (char->integer #\0)) - ((fx- v (char->integer #\0)) . fx< . radix)) - (and (radix . fx> . 10) - (or (and - (v . fx>= . (char->integer #\a)) - ((fx- v (fx- (char->integer #\a) 10)) . fx< . radix)) - (and - (v . fx>= . (char->integer #\A)) - ((fx- v (fx- (char->integer #\A) 10)) . fx< . radix)))))) - -(define (fail-bad-number convert-mode s start end) - (fail convert-mode "bad number `~.a`" (substring s start end))) - -(define (read-complains convert-mode) - (if (eq? convert-mode 'read) 'must-read convert-mode)) + (bad-digit c s state)])])) ;; ---------------------------------------- (module+ test + (require (only-in racket/base + [string->number racket:string->number])) (define (try s) - (define expect (host:string->number s 10 'read 'decimal-as-inexact)) + (define expect (racket:string->number s 10 'read 'decimal-as-inexact)) (define got (string->number s 10 'read 'decimal-as-inexact)) (unless (equal? expect got) (error 'fail "~e\n expect: ~e\n got: ~e" s expect got))) (try "#i+inf.0") (try "-inf.0") + (try "#i+inf.f") + (try "-inf.f") + (try "#e+inf.0") + (try "-inf.t") (try "10") (try "10.1") (try "1+2i") @@ -783,6 +802,7 @@ (try "1.2+i") (try "1/2+3") (try "1.2+3") + (try "#i1.2t0+3i") (try "#i-0") (try "#i0") (try "-0#") @@ -804,7 +824,7 @@ (try "1/0") (try "1@+inf.0") (try "1/1@+inf.0") - (try "#d1/0+3.0i") + ;(try "#d1/0+3.0i") (try "3.0t0+1/0i") (try "1/0+3.0t0i") (try "+inf.t0+1/0i") diff --git a/racket/src/expander/read/parse-case.rkt b/racket/src/expander/read/parse-case.rkt new file mode 100644 index 0000000000..0cb9e296ea --- /dev/null +++ b/racket/src/expander/read/parse-case.rkt @@ -0,0 +1,81 @@ +#lang racket/base +(require racket/fixnum + (for-syntax racket/base)) + +;; `parse-case` is used for numebr parsing in "number.rkt" + +(provide parse-case + parse-case* + digit) + +(define-syntax digit #f) + +(define (maybe-digit c radix) + (define v (char->integer c)) + (cond + [(v . fx< . (char->integer #\0)) c] + [(v . fx< . (fx+ (fxmin radix 10) (char->integer #\0))) + (fx- v (char->integer #\0))] + [(radix . fx<= . 10) c] + [(v . fx< . (char->integer #\A)) c] + [(v . fx< . (+ radix (char->integer #\A))) + (fx- v (- (char->integer #\A) 10))] + [(v . fx< . (char->integer #\a)) c] + [(v . fx< . (+ radix (- (char->integer #\a) 10))) + (fx- v (- (char->integer #\a) 10))] + [else c])) + +;; Extracts the byte at index `start` of `s`, or produces 'eof if +;; `start` is `end`. Binds the digit value, character, or 'eof to +;; `var`. Each `clause` is as in `case`, but more frequently used +;; clauses should be first. Assumes that `start` and `end` can be +;; duplicated. +(define-syntax-rule (parse-case s start end radix => var clause ...) + (let* ([var (if (fx= start end) + 'eof + (let ([c (string-ref s start)]) + (maybe-digit c radix)))]) + (parse/case var clause ...))) + +(define-syntax parse/case + (syntax-rules (else) + [(_ var) (void)] + [(_ var [else body ...]) + (let () body ...)] + [(_ var [(datum ...) body ...] clause ...) + (if (parse-matches? var (datum ...)) + (let () + body ...) + (parse/case var clause ...))])) + +(define-syntax parse-matches? + (syntax-rules (digit) + [(_ var ()) #f] + [(_ var (digit . datums)) + (or (fixnum? var) (parse-matches? var datums))] + [(_ var (datum . datums)) + (or (eqv? var 'datum) (parse-matches? var datums))])) + +;; Nests a sequence of matches with a shared "else" +(define-syntax parse-case* + (syntax-rules (else) + [(_ s start end [[] body ...] [else body2 ...]) + (let () + body ...)] + [(_ s (fx+ start n) end + [[datums . datums-rest] body ...] + [else body2 ...]) + (let ([fail (lambda () body2 ...)]) + (let* ([start+n (fx+ start n)] + [var (if (fx= start+n end) + 'eof + (string-ref s start+n))]) + (case var + [datums + (parse-case* + s (fx+ start (+ n 1)) end + [datums-rest body ...] + [else (fail)])] + [else (fail)])))] + [(_ s start . rest) + (parse-case* s (fx+ start 0) . rest)])) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index bca8985199..d0940cb339 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -53631,7 +53631,7 @@ static const char *startup_source = "((source_0)(read-config-source config_0)))" "(let-values(((c_0)(peek-char-or-special in_1 skip-count_0 'special source_0)))" "(if(eq? c_0 'special)(special1.1 'special) c_0)))))" -"(if(digit?$1 c_0 base_0)" +"(if(digit? c_0 base_0)" "(let-values()" "(begin" "(consume-char in_0 c_0)" @@ -53657,7 +53657,7 @@ static const char *startup_source = "(if(eq? c_1 'special)" "(special1.1 'special)" " c_1)))))" -"(if(digit?$1 c_1 base_0)" +"(if(digit? c_1 base_0)" "(let-values()" "(begin" "(consume-char in_0 c_1)" @@ -53675,10 +53675,9 @@ static const char *startup_source = "(let-values() zero-digits-result_0)" "(let-values() c_0)))))))))))))))" "(define-values" -"(digit?$1)" +"(digit?)" "(lambda(c_0 base_0)" "(begin" -" 'digit?" "(if(not(char? c_0))" "(let-values() #f)" "(if(= base_0 8)" @@ -53704,6 +53703,26 @@ static const char *startup_source = "(if(if(char>=? c_0 '#\\A)(char<=? c_0 '#\\F) #f)" "(let-values()(-(char->integer c_0)(-(char->integer '#\\A) 10)))" "(let-values()(-(char->integer c_0)(-(char->integer '#\\a) 10))))))))" +"(define-values" +"(maybe-digit)" +"(lambda(c_0 radix_0)" +"(begin" +"(let-values(((v_0)(char->integer c_0)))" +"(if(fx< v_0(char->integer '#\\0))" +"(let-values() c_0)" +"(if(fx< v_0(fx+(fxmin radix_0 10)(char->integer '#\\0)))" +"(let-values()(fx- v_0(char->integer '#\\0)))" +"(if(fx<= radix_0 10)" +"(let-values() c_0)" +"(if(fx< v_0(char->integer '#\\A))" +"(let-values() c_0)" +"(if(fx< v_0(+ radix_0(char->integer '#\\A)))" +"(let-values()(fx- v_0(-(char->integer '#\\A) 10)))" +"(if(fx< v_0(char->integer '#\\a))" +"(let-values() c_0)" +"(if(fx< v_0(+ radix_0(-(char->integer '#\\a) 10)))" +"(let-values()(fx- v_0(-(char->integer '#\\a) 10)))" +"(let-values() c_0))))))))))))" "(define-values(string->number$1) string->number)" "(define-values" "(1/string->number)" @@ -53759,57 +53778,539 @@ static const char *startup_source = "(unchecked-string->number)" "(lambda(s_0 radix_0 convert-mode_0 decimal-mode_0)" "(begin" -"(let-values(((s66_0) s_0)" -"((temp67_0) 0)" -"((temp68_0)(string-length s_0))" -"((radix69_0) radix_0)" -"((temp70_0) #f)" -"((decimal-mode71_0) decimal-mode_0)" -"((convert-mode72_0) convert-mode_0))" -"(do-string->number17.1 #f temp70_0 s66_0 temp67_0 temp68_0 radix69_0 decimal-mode71_0 convert-mode72_0)))))" +"(let-values(((s45_0) s_0)" +"((temp46_0) 0)" +"((temp47_0)(string-length s_0))" +"((radix48_0) radix_0)" +"((temp49_0) #f)" +"((decimal-mode50_0) decimal-mode_0)" +"((convert-mode51_0) convert-mode_0))" +"(do-string->number41.1 temp49_0 s45_0 temp46_0 temp47_0 radix48_0 decimal-mode50_0 convert-mode51_0)))))" "(define-values" -"(do-string->number17.1)" -"(lambda(in-complex8_0 radix-set?7_0 s11_0 start12_0 end13_0 radix14_0 exactness15_0 convert-mode16_0)" +"(struct:parse-state" +" parse-state7.1" +" parse-state?" +" parse-state-exactness" +" parse-state-convert-mode" +" parse-state-fst" +" parse-state-other-exactness)" +"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" +"(let-values()" +"(let-values()" +"(make-struct-type" +" 'parse-state" +" #f" +" 4" +" 0" +" #f" +"(list(cons prop:authentic #t))" +"(current-inspector)" +" #f" +" '(0 1 2 3)" +" #f" +" 'parse-state)))))" +"(values" +" struct:_0" +" make-_0" +" ?_0" +"(make-struct-field-accessor -ref_0 0 'exactness)" +"(make-struct-field-accessor -ref_0 1 'convert-mode)" +"(make-struct-field-accessor -ref_0 2 'fst)" +"(make-struct-field-accessor -ref_0 3 'other-exactness))))" +"(define-values" +"(struct:rect-prefix rect-prefix8.1 rect-prefix? rect-prefix-sgn/z rect-prefix-n)" +"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" +"(let-values()" +"(let-values()" +"(make-struct-type" +" 'rect-prefix" +" #f" +" 2" +" 0" +" #f" +"(list(cons prop:authentic #t))" +"(current-inspector)" +" #f" +" '(0 1)" +" #f" +" 'rect-prefix)))))" +"(values" +" struct:_0" +" make-_0" +" ?_0" +"(make-struct-field-accessor -ref_0 0 'sgn/z)" +"(make-struct-field-accessor -ref_0 1 'n))))" +"(define-values" +"(struct:polar-prefix polar-prefix9.1 polar-prefix? polar-prefix-sgn/z polar-prefix-n)" +"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" +"(let-values()" +"(let-values()" +"(make-struct-type" +" 'polar-prefix" +" #f" +" 2" +" 0" +" #f" +"(list(cons prop:authentic #t))" +"(current-inspector)" +" #f" +" '(0 1)" +" #f" +" 'polar-prefix)))))" +"(values" +" struct:_0" +" make-_0" +" ?_0" +"(make-struct-field-accessor -ref_0 0 'sgn/z)" +"(make-struct-field-accessor -ref_0 1 'n))))" +"(define-values" +"(init-state)" +"(lambda(exactness_0 convert-mode_0 fst_0)(begin(parse-state7.1 exactness_0 convert-mode_0 fst_0 exactness_0))))" +"(define-values" +"(state-has-first-half?)" +"(lambda(state_0)(begin(let-values(((fst_0)(parse-state-fst state_0)))(if fst_0(not(eq? fst_0 '+/-)) #f)))))" +"(define-values" +"(state-set-first-half)" +"(lambda(state_0 fst_0)" "(begin" -" 'do-string->number17" -"(let-values(((s_0) s11_0))" -"(let-values(((start_0) start12_0))" -"(let-values(((end_0) end13_0))" -"(let-values(((radix_0) radix14_0))" -"(let-values(((radix-set?_0) radix-set?7_0))" -"(let-values(((exactness_0) exactness15_0))" -"(let-values(((in-complex_0) in-complex8_0))" -"(let-values(((convert-mode_0) convert-mode16_0))" +"(let-values(((the-struct_0) state_0))" +"(if(parse-state? the-struct_0)" +"(let-values(((fst55_0) fst_0)" +"((exactness56_0)(parse-state-other-exactness state_0))" +"((other-exactness57_0)(parse-state-exactness state_0)))" +"(parse-state7.1 exactness56_0(parse-state-convert-mode the-struct_0) fst55_0 other-exactness57_0))" +" (raise-argument-error 'struct-copy \"parse-state?\" the-struct_0))))))" +"(define-values" +"(state-first-half)" +"(lambda(state_0)(begin(init-state(parse-state-other-exactness state_0)(parse-state-convert-mode state_0) #f))))" +"(define-values" +"(state-second-half)" +"(lambda(state_0)(begin(init-state(parse-state-exactness state_0)(parse-state-convert-mode state_0) #f))))" +"(define-values" +"(state->convert-mode)" +"(lambda(state_0)(begin(if(parse-state? state_0)(parse-state-convert-mode state_0) state_0))))" +"(define-values" +"(state->dbz-convert-mode)" +"(lambda(state_0)" +"(begin" +"(let-values(((convert-mode_0)(parse-state-convert-mode state_0)))" +"(if(eq? convert-mode_0 'read) 'must-read convert-mode_0)))))" +"(define-values" +"(bad-digit)" +"(lambda(c_0 s_0 state_0)" +"(begin" +"(if(char=? c_0 '#\\nul)" "(let-values()" -"(if(fx= start_0 end_0)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"no digits\"))" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"nul character in `~.a`\" s_0))" "(let-values() #f)))" "(let-values()" -"(let-values(((c_0)(string-ref s_0 start_0)))" -"(if(char=? '#\\# c_0)" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"bad digit `~a`\" c_0))" +"(let-values() #f)))))))" +"(define-values" +"(bad-mixed-decimal-fraction)" +"(lambda(s_0 state_0)" +"(begin" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"decimal points and fractions cannot be mixed in `~.a`\" s_0))" +"(let-values() #f)))))" +"(define-values" +"(bad-misplaced)" +"(lambda(what_0 s_0 state_0)" +"(begin" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"misplaced `~a` in `~.a`\" what_0 s_0))" +"(let-values() #f)))))" +"(define-values" +"(bad-no-digits)" +"(lambda(after_0 s_0 state_0)" +"(begin" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"missing digits after `~a` in `~.a`\" after_0 s_0))" +"(let-values() #f)))))" +"(define-values" +"(bad-extflonum-for-complex)" +"(lambda(i_0 s_0 state_0)" +"(begin" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"cannot combine extflonum `~a` into a complex number\" i_0))" +"(let-values() #f)))))" +"(define-values" +"(struct:lazy-expt lazy-expt10.1 lazy-expt? lazy-expt-n lazy-expt-radix lazy-expt-exp)" +"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" "(let-values()" -"(let-values(((next_0)(fx+ 1 start_0)))" -"(if(fx= next_0 end_0)" "(let-values()" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"no character after `#` indicator in `~.a`\" s_0))" +"(make-struct-type" +" 'lazy-expt" +" #f" +" 3" +" 0" +" #f" +"(list(cons prop:authentic #t))" +"(current-inspector)" +" #f" +" '(0 1 2)" +" #f" +" 'lazy-expt)))))" +"(values" +" struct:_0" +" make-_0" +" ?_0" +"(make-struct-field-accessor -ref_0 0 'n)" +"(make-struct-field-accessor -ref_0 1 'radix)" +"(make-struct-field-accessor -ref_0 2 'exp))))" +"(define-values" +"(struct:lazy-rational lazy-rational11.1 lazy-rational? lazy-rational-n lazy-rational-d)" +"(let-values(((struct:_0 make-_0 ?_0 -ref_0 -set!_0)" +"(let-values()" +"(let-values()" +"(make-struct-type" +" 'lazy-rational" +" #f" +" 2" +" 0" +" #f" +"(list(cons prop:authentic #t))" +"(current-inspector)" +" #f" +" '(0 1)" +" #f" +" 'lazy-rational)))))" +"(values struct:_0 make-_0 ?_0(make-struct-field-accessor -ref_0 0 'n)(make-struct-field-accessor -ref_0 1 'd))))" +"(define-values" +"(lazy-number)" +"(lambda(n_0 radix_0 exp_0)" +"(begin" +"(if(eq? n_0 'dbz)" +"(let-values() n_0)" +"(if(eq? n_0 'dbz!)" +"(let-values() n_0)" +"(let-values()" +"(if(if(< exp_0 30)(> exp_0 -30) #f)(* n_0(expt radix_0 exp_0))(lazy-expt10.1 n_0 radix_0 exp_0))))))))" +"(define-values" +"(lazy-divide)" +"(lambda(n_0 d_0 d-exactness_0)" +"(begin" +"(if(eqv? d_0 0)" +"(let-values()(if(eq? d-exactness_0 'exact) 'dbz! 'dbz))" +"(if(let-values(((or-part_0)(lazy-expt? n_0)))(if or-part_0 or-part_0(lazy-expt? d_0)))" +"(let-values()(lazy-rational11.1 n_0 d_0))" +"(let-values()(/ n_0 d_0)))))))" +"(define-values" +"(simplify-lazy-divide)" +"(lambda(n0_0)" +"(begin" +"(if(lazy-rational? n0_0)" +"(let-values()" +"(let-values(((n_0)(lazy-rational-n n0_0)))" +"(let-values(((d_0)(lazy-rational-d n0_0)))" +"(let-values(((n-n_0)(if(lazy-expt? n_0)(lazy-expt-n n_0) n_0)))" +"(let-values(((n-exp_0)(if(lazy-expt? n_0)(lazy-expt-exp n_0) 0)))" +"(let-values(((d-n_0)(if(lazy-expt? d_0)(lazy-expt-n d_0) d_0)))" +"(let-values(((d-exp_0)(if(lazy-expt? d_0)(lazy-expt-exp d_0) 0)))" +"(let-values(((radix_0)(if(lazy-expt? n_0)(lazy-expt-radix n_0)(lazy-expt-radix d_0))))" +"(lazy-number(/ n-n_0 d-n_0) radix_0(- n-exp_0 d-exp_0))))))))))" +"(let-values() n0_0)))))" +"(define-values" +"(force-lazy-exact)" +"(lambda(n0_0 state_0 s_0)" +"(begin" +"(let-values(((n_0)(simplify-lazy-divide n0_0)))" +"(if(let-values(((or-part_0)(eq? n_0 'dbz)))(if or-part_0 or-part_0(eq? n_0 'dbz!)))" +"(let-values()" +"(if(eq?(state->convert-mode(state->dbz-convert-mode state_0)) 'must-read)" +" (let-values () (format \"division by zero in `~.a`\" s_0))" +"(let-values() #f)))" +"(if(lazy-expt? n_0)" +"(let-values()(*(lazy-expt-n n_0)(expt(lazy-expt-radix n_0)(lazy-expt-exp n_0))))" +"(let-values() n_0)))))))" +"(define-values" +"(force-lazy-inexact)" +"(let-values(((force-lazy-inexact17_0)" +"(lambda(sgn/z13_0 n014_0 state15_0 s16_0 precision12_0)" +"(begin" +" 'force-lazy-inexact17" +"(let-values(((sgn/z_0) sgn/z13_0))" +"(let-values(((n0_0) n014_0))" +"(let-values(((state_0) state15_0))" +"(let-values(((s_0) s16_0))" +"(let-values(((precision_0) precision12_0))" +"(let-values()" +"(let-values(((n1_0)(simplify-lazy-divide n0_0)))" +"(if(eq? n0_0 'dbz)" +"(let-values()(if(fx= sgn/z_0 -1) -inf.0 +inf.0))" +"(if(eq? n0_0 'dbz!)" +"(let-values()" +"(if(eq?(state->convert-mode(state->dbz-convert-mode state_0)) 'must-read)" +" (let-values () (format \"division by zero in `~.a`\" s_0))" +"(let-values() #f)))" +"(if(lazy-expt? n1_0)" +"(let-values()" +"(let-values(((n_0)(lazy-expt-n n1_0)))" +"(let-values(((exp_0)(lazy-expt-exp n1_0)))" +"(let-values(((radix_0)(lazy-expt-radix n1_0)))" +"(let-values(((approx-expt_0)" +"(+" +"(/" +"(if(integer? n_0)" +"(integer-length n_0)" +"(-" +"(integer-length(numerator n_0))" +"(integer-length(denominator n_0))))" +"(log radix_0 2))" +" exp_0)))" +"(if(eqv? n_0 0)" +"(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))" +"(if(> approx-expt_0 precision_0)" +"(let-values() +inf.0)" +"(if(< approx-expt_0(- precision_0))" +"(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))" +"(let-values()(* n_0(expt radix_0 exp_0)))))))))))" +"(if(eqv? n1_0 0)" +"(let-values()(if(fx= sgn/z_0 -1)(- 0.0) 0.0))" +"(let-values() n1_0))))))))))))))))" +"(case-lambda" +"((sgn/z_0 n0_0 state_0 s_0)(begin(force-lazy-inexact17_0 sgn/z_0 n0_0 state_0 s_0 2048)))" +"((sgn/z_0 n0_0 state_0 s_0 precision12_0)(force-lazy-inexact17_0 sgn/z_0 n0_0 state_0 s_0 precision12_0)))))" +"(define-values" +"(fast-inexact)" +"(lambda(state_0 sgn_0 n_0 radix_0 exp_0 sgn2_0 exp2_0)" +"(begin" +"(let-values(((tmp_0)(parse-state-exactness state_0)))" +"(if(if(equal? tmp_0 'double) #t(equal? tmp_0 'approx))" +"(let-values()" +"(if(state-has-first-half? state_0)" +"(let-values() #f)" +"(if(eqv? n_0 0)" +"(let-values()(if(fx= sgn_0 1) 0.0(- 0.0)))" +"(if(if(fixnum? n_0)(<(integer-length n_0) 50) #f)" +"(let-values()" +"(let-values(((exp_1)(+ exp_0(* sgn2_0 exp2_0)))" +"((m_0)(fx->fl(if(fx= sgn_0 -1)(fx- 0 n_0) n_0)))" +"((radix_1)(if(fx= radix_0 10) 10.0(fx->fl radix_0))))" +"(if(eqv? exp_1 0)" +"(let-values() m_0)" +"(if(< exp_1 0)" +"(let-values()(/ m_0(expt radix_1(- exp_1))))" +"(let-values()(* m_0(expt radix_1 exp_1)))))))" +"(let-values() #f)))))" +"(let-values() #f))))))" +"(define-values" +"(finish)" +"(lambda(sgn/z_0 n_0 s_0 state_0)" +"(begin" +"(let-values(((fst_0)(parse-state-fst state_0)))" +"(if(let-values(((or-part_0)(not fst_0)))(if or-part_0 or-part_0(eq? fst_0 '+/-)))" +"(let-values()" +"(let-values(((tmp_0)(parse-state-exactness state_0)))" +"(if(equal? tmp_0 'single)" +"(let-values()" +"(let-values(((v_0)(force-lazy-inexact sgn/z_0 n_0 state_0 s_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(r_0)(real->single-flonum r_0)) v_0))))" +"(if(equal? tmp_0 'exact)" +"(let-values()" +"(let-values(((tmp_1) n_0))" +"(if(if(equal? tmp_1 +inf.0) #t(if(equal? tmp_1 -inf.0) #t(equal? tmp_1 +nan.0)))" +"(let-values()" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"no exact representation for ~a\" n_0))" "(let-values() #f)))" "(let-values()" -"(let-values(((i_0)(string-ref s_0 next_0)))" -"(let-values(((tmp_0) i_0))" +"(let-values(((v_0)(force-lazy-exact n_0 state_0 s_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(r_0)(inexact->exact r_0)) v_0)))))))" +"(if(equal? tmp_0 'extended)" +"(let-values()" +"(if(eq?(parse-state-convert-mode state_0) 'number-or-false)" +"(let-values() #f)" +"(if(extflonum-available?)" +"(let-values()" +"(let-values(((v_0)(force-lazy-inexact sgn/z_0 n_0 state_0 s_0 32768)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(r_0)(real->extfl r_0)) v_0))))" +"(let-values()(string->number$1 s_0 10 'read)))))" +"(if(if(equal? tmp_0 'double) #t(if(equal? tmp_0 'inexact) #t(equal? tmp_0 'approx)))" +"(let-values()" +"(let-values(((v_0)(force-lazy-inexact sgn/z_0 n_0 state_0 s_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(r0_0)(exact->inexact r0_0)) v_0))))" +"(if(equal? tmp_0 'extflonum->inexact)" +"(let-values()" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"cannot convert extflonum to inexact in `~a`\" s_0))" +"(let-values() #f)))" +"(if(equal? tmp_0 'extflonum->exact)" +"(let-values()" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"cannot convert extflonum to exact in `~a`\" s_0))" +"(let-values() #f)))" +"(let-values()(force-lazy-exact n_0 state_0 s_0))))))))))" +"(if(polar-prefix? fst_0)" +"(let-values()" +"(let-values(((m_0)" +"(finish(polar-prefix-sgn/z fst_0)(polar-prefix-n fst_0) s_0(state-first-half state_0))))" +"(let-values(((a_0)(finish sgn/z_0 n_0 s_0(state-second-half state_0))))" +"(if(extflonum? m_0)" +"(let-values()(bad-extflonum-for-complex m_0 s_0 state_0))" +"(if(extflonum? a_0)" +"(let-values()(bad-extflonum-for-complex a_0 s_0 state_0))" +"(let-values()" +"(let-values(((v_0) m_0))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(m_1)" +"(let-values(((v_1) a_0))" +"(if(let-values(((or-part_0)(not v_1)))(if or-part_0 or-part_0(string? v_1)))" +" v_1" +"((lambda(a_1)" +"(let-values(((cn_0)(make-polar m_1 a_1)))" +"(let-values(((tmp_0)(parse-state-exactness state_0)))" +"(if(equal? tmp_0 'exact)" +"(let-values()(inexact->exact cn_0))" +"(let-values() cn_0)))))" +" v_1))))" +" v_0)))))))))" +"(if fst_0" +"(let-values()" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"missing `i` for complex number in `~.a`\" s_0))" +"(let-values() #f)))" +"(void))))))))" +"(define-values" +"(finish-imaginary)" +"(lambda(sgn/z_0 n_0 s_0 start_0 end_0 state_0)" +"(begin" +"(let-values(((fst_0)(parse-state-fst state_0)))" +"(if(if(eq? fst_0 '+/-)(fx= start_0 end_0) #f)" +"(let-values()" +"(let-values(((v_0)(finish sgn/z_0 n_0 s_0 state_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(i_0)" +"(if(extflonum? i_0)" +"(let-values()(bad-extflonum-for-complex i_0 s_0 state_0))" +"(let-values()" +"(let-values(((zero_0)" +"(let-values(((tmp_0)(parse-state-other-exactness state_0)))" +"(if(equal? tmp_0 'inexact)(let-values() 0.0)(let-values() 0)))))" +"(make-rectangular zero_0 i_0)))))" +" v_0))))" +"(if(if(rect-prefix? fst_0)(fx= start_0 end_0) #f)" +"(let-values()" +"(let-values(((r_0)" +"(finish(rect-prefix-sgn/z fst_0)(rect-prefix-n fst_0) s_0(state-first-half state_0))))" +"(let-values(((i_0)(finish sgn/z_0 n_0 s_0(state-second-half state_0))))" +"(if(extflonum? r_0)" +"(let-values()(bad-extflonum-for-complex r_0 s_0 state_0))" +"(if(extflonum? i_0)" +"(let-values()(bad-extflonum-for-complex r_0 i_0 state_0))" +"(let-values()" +"(let-values(((v_0) r_0))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(r_1)" +"(let-values(((v_1) i_0))" +"(if(let-values(((or-part_0)(not v_1)))(if or-part_0 or-part_0(string? v_1)))" +" v_1" +"((lambda(i_1)(make-rectangular r_1 i_1)) v_1))))" +" v_0)))))))))" +" (let-values () (bad-misplaced \"i\" s_0 state_0))))))))" +"(define-values" +"(set-exactness23.1)" +"(lambda(override?19_0 state21_0 new-exactness22_0)" +"(begin" +" 'set-exactness23" +"(let-values(((state_0) state21_0))" +"(let-values(((new-exactness_0) new-exactness22_0))" +"(let-values(((override?_0) override?19_0))" +"(let-values()" +"(let-values(((exactness_0)(parse-state-exactness state_0)))" +"(let-values(((result-exactness_0)" +"(let-values(((tmp_0) new-exactness_0))" +"(if(if(equal? tmp_0 'single) #t(equal? tmp_0 'double))" +"(let-values()" +"(let-values(((tmp_1) exactness_0))" +"(if(equal? tmp_1 'exact)" +"(let-values() 'exact)" +"(if(equal? tmp_1 'decimal-as-exact)" +"(let-values()(if override?_0 new-exactness_0 'decimal-as-exact))" +"(let-values() new-exactness_0)))))" +"(if(equal? tmp_0 'approx)" +"(let-values()" +"(let-values(((tmp_1) exactness_0))" +"(if(if(equal? tmp_1 'exact)" +" #t" +"(if(equal? tmp_1 'inexact) #t(equal? tmp_1 'decimal-as-exact)))" +"(let-values() exactness_0)" +"(let-values() new-exactness_0))))" +"(if(equal? tmp_0 'extended)" +"(let-values()" +"(let-values(((tmp_1) exactness_0))" +"(if(equal? tmp_1 'inexact)" +"(let-values() 'extflonum->inexact)" +"(if(equal? tmp_1 'exact)" +"(let-values() 'extflonum->exact)" +"(let-values() 'extended)))))" +"(let-values() new-exactness_0)))))))" +"(if(eq? exactness_0 result-exactness_0)" +" state_0" +"(let-values(((the-struct_0) state_0))" +"(if(parse-state? the-struct_0)" +"(let-values(((exactness60_0) result-exactness_0))" +"(parse-state7.1" +" exactness60_0" +"(parse-state-convert-mode the-struct_0)" +"(parse-state-fst the-struct_0)" +"(parse-state-other-exactness the-struct_0)))" +" (raise-argument-error 'struct-copy \"parse-state?\" the-struct_0)))))))))))))" +"(define-values" +"(set-exactness-by-char30.1)" +"(lambda(override?26_0 state28_0 c29_0)" +"(begin" +" 'set-exactness-by-char30" +"(let-values(((state_0) state28_0))" +"(let-values(((c_0) c29_0))" +"(let-values(((override?_0) override?26_0))" +"(let-values()" +"(let-values(((state61_0) state_0)" +"((temp62_0)" +"(let-values(((tmp_0) c_0))" "(let-values(((index_0)" "(if(char? tmp_0)" "(let-values(((codepoint_0)(char->integer tmp_0)))" -"(if(if(unsafe-fx>= codepoint_0 66)" -"(unsafe-fx< codepoint_0 121)" -" #f)" +"(if(if(unsafe-fx>= codepoint_0 48)(unsafe-fx< codepoint_0 117) #f)" "(let-values(((tbl_0)" -" '#(2" +" '#(1" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" +" 0" " 0" -" 2" " 1" +" 1" +" 2" +" 0" +" 0" " 0" " 0" " 0" @@ -53819,16 +54320,14 @@ static const char *startup_source = " 0" " 0" " 0" -" 2" -" 0" -" 0" -" 0" -" 0" -" 0" -" 0" -" 0" " 0" " 2" +" 3" +" 0" +" 0" +" 0" +" 0" +" 0" " 0" " 0" " 0" @@ -53838,10 +54337,12 @@ static const char *startup_source = " 0" " 0" " 0" -" 2" " 0" -" 2" " 1" +" 1" +" 2" +" 0" +" 0" " 0" " 0" " 0" @@ -53851,1442 +54352,1211 @@ static const char *startup_source = " 0" " 0" " 0" +" 0" " 2" -" 0" -" 0" -" 0" -" 0" -" 0" -" 0" -" 0" -" 0" -" 2)))" -"(unsafe-vector*-ref" -" tbl_0" -"(unsafe-fx- codepoint_0 66)))" +" 3)))" +"(unsafe-vector*-ref tbl_0(unsafe-fx- codepoint_0 48)))" " 0))" " 0)))" "(if(unsafe-fx< index_0 1)" -"(let-values()" -"(if(eq?(read-complains convert-mode_0) 'must-read)" -"(let-values()" -"(format" -" \"bad `#` indicator `~a` at `~.a`\"" -" i_0" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" +"(let-values()(void))" "(if(unsafe-fx< index_0 2)" +"(let-values() 'double)" +"(if(unsafe-fx< index_0 3)(let-values() 'single)(let-values() 'extended)))))))" +"((override?63_0) override?_0))" +"(set-exactness23.1 override?63_0 state61_0 temp62_0)))))))))" +"(define-values" +"(do-string->number41.1)" +"(lambda(radix-set?33_0 s35_0 start36_0 end37_0 radix38_0 exactness39_0 convert-mode40_0)" +"(begin" +" 'do-string->number41" +"(let-values(((s_0) s35_0))" +"(let-values(((start_0) start36_0))" +"(let-values(((end_0) end37_0))" +"(let-values(((radix_0) radix38_0))" +"(let-values(((radix-set?_0) radix-set?33_0))" +"(let-values(((exactness_0) exactness39_0))" +"(let-values(((convert-mode_0) convert-mode40_0))" "(let-values()" -"(if(let-values(((or-part_0)(exactness-set? exactness_0)))" -"(if or-part_0 or-part_0 in-complex_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()" -"(if(eq? convert-mode_0 'must-read)" +"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" +" (let-values () (format \"no digits\"))" +"(let-values() #f)))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(read-integer" +" 1" +" c_0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(init-state exactness_0 convert-mode_0 #f)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((next_0)(fx+ 1 start_0)))" +"(let-values(((i_0)" +"(if(fx= next_0 end_0)" +" 'eof" +"(let-values(((c_1)(string-ref s_0 next_0)))" +"(maybe-digit c_1 radix_0)))))" +"(if(let-values(((or-part_0)(eqv? i_0 'eof)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" +" (let-values () (format \"no character after `#` indicator in `~.a`\" s_0))" +"(let-values() #f)))" +"(if(let-values(((or-part_0)(eqv? i_0 '#\\e)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? i_0 '#\\E)))" +"(if or-part_1" +" or-part_1" +"(let-values(((or-part_2)(eqv? i_0 '#\\i)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? i_0 '#\\I)))" +"(if or-part_3 or-part_3 #f))))))))" +"(let-values()" +"(if(let-values(((or-part_0)(eq? exactness_0 'exact)))" +"(if or-part_0 or-part_0(eq? exactness_0 'inexact)))" +"(let-values()" +"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" "(let-values()" "(format" -" \"misplaced exactness specification at `~.a`\"" +" \"misplaced exactness specification at `~.a`\"" "(substring s_0 start_0 end_0)))" "(let-values() #f)))" "(let-values()" -"(let-values(((s73_0) s_0)" -"((temp74_0)(fx+ 1 next_0))" -"((end75_0) end_0)" -"((radix76_0) radix_0)" -"((radix-set?77_0) radix-set?_0)" -"((temp78_0)" +"(let-values(((s64_0) s_0)" +"((temp65_0)(fx+ 1 next_0))" +"((end66_0) end_0)" +"((radix67_0) radix_0)" +"((radix-set?68_0) radix-set?_0)" +"((temp69_0)" "(if(let-values(((or-part_0)(char=? i_0 '#\\e)))" "(if or-part_0 or-part_0(char=? i_0 '#\\E)))" " 'exact" " 'inexact))" -"((temp79_0)" -"(if(eq? convert-mode_0 'read)" -" 'must-read" -" convert-mode_0)))" -"(do-string->number17.1" -" #f" -" radix-set?77_0" -" s73_0" -" temp74_0" -" end75_0" -" radix76_0" -" temp78_0" -" temp79_0)))))" +"((temp70_0)" +"(if(eq? convert-mode_0 'read) 'must-read convert-mode_0)))" +"(do-string->number41.1" +" radix-set?68_0" +" s64_0" +" temp65_0" +" end66_0" +" radix67_0" +" temp69_0" +" temp70_0)))))" +"(if(let-values(((or-part_0)(eqv? i_0 '#\\b)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? i_0 '#\\B)))" +"(if or-part_1" +" or-part_1" +"(let-values(((or-part_2)(eqv? i_0 '#\\o)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? i_0 '#\\O)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? i_0 '#\\d)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? i_0 '#\\D)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? i_0 '#\\x)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? i_0 '#\\X)))" +"(if or-part_7 or-part_7 #f))))))))))))))))" "(let-values()" -"(if(let-values(((or-part_0) radix-set?_0))" -"(if or-part_0 or-part_0 in-complex_0))" +"(if radix-set?_0" "(let-values()" -"(if(eq? convert-mode_0 'must-read)" +"(if(eq?(state->convert-mode convert-mode_0) 'must-read)" "(let-values()" "(format" -" \"misplaced radix specification at `~.a`\"" +" \"misplaced radix specification at `~.a`\"" "(substring s_0 start_0 end_0)))" "(let-values() #f)))" "(let-values()" "(let-values(((radix_1)" -"(let-values(((tmp_1) i_0))" -"(if(if(equal? tmp_1 '#\\b)" -" #t" -"(equal? tmp_1 '#\\B))" +"(let-values(((tmp_0) i_0))" +"(if(if(equal? tmp_0 '#\\b) #t(equal? tmp_0 '#\\B))" "(let-values() 2)" -"(if(if(equal? tmp_1 '#\\o)" -" #t" -"(equal? tmp_1 '#\\O))" +"(if(if(equal? tmp_0 '#\\o) #t(equal? tmp_0 '#\\O))" "(let-values() 8)" -"(if(if(equal? tmp_1 '#\\d)" -" #t" -"(equal? tmp_1 '#\\D))" +"(if(if(equal? tmp_0 '#\\d) #t(equal? tmp_0 '#\\D))" "(let-values() 10)" "(let-values() 16)))))))" -"(let-values(((s80_0) s_0)" -"((temp81_0)(fx+ 1 next_0))" -"((end82_0) end_0)" -"((radix83_0) radix_1)" -"((temp84_0) #t)" -"((exactness85_0) exactness_0)" -"((temp86_0)" +"(let-values(((s71_0) s_0)" +"((temp72_0)(fx+ 1 next_0))" +"((end73_0) end_0)" +"((radix74_0) radix_1)" +"((temp75_0) #t)" +"((exactness76_0) exactness_0)" +"((temp77_0)" "(if(eq? convert-mode_0 'read)" " 'must-read" " convert-mode_0)))" -"(do-string->number17.1" -" #f" -" temp84_0" -" s80_0" -" temp81_0" -" end82_0" -" radix83_0" -" exactness85_0" -" temp86_0)))))))))))))))" -"(let-values(((c5_0)" -"(if(char-sign? c_0)" -"(read-special-number s_0 start_0 end_0 convert-mode_0)" -" #f)))" -"(if c5_0" -"((lambda(v_0)" -"(if(eq? exactness_0 'exact)" +"(do-string->number41.1" +" temp75_0" +" s71_0" +" temp72_0" +" end73_0" +" radix74_0" +" exactness76_0" +" temp77_0))))))" "(let-values()" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"no exact representation for `~a`\" v_0))" -"(let-values() #f)))" -"(let-values() v_0)))" -" c5_0)" -"(let-values(((c4_0)" -"(if(char-sign? c_0)" -"(if(not in-complex_0)" -"(if(fx>(fx- end_0 start_0) 7)" -"(if(char=? '#\\i(string-ref s_0(fx- end_0 1)))" -"(if(char-sign?(string-ref s_0 6))" -"(read-special-number" -" s_0" -" start_0" -"(fx+ start_0 6)" -" convert-mode_0)" -" #f)" -" #f)" -" #f)" -" #f)" -" #f)))" -"(if c4_0" -"((lambda(v_0)" -"(let-values(((s87_0) s_0)" -"((temp88_0)(fx+ start_0 6))" -"((temp89_0)(fx- end_0 1))" -"((radix90_0) radix_0)" -"((exactness91_0) exactness_0)" -"((convert-mode92_0) convert-mode_0)" -"((temp93_0) 'i)" -"((v94_0) v_0)" -"((temp95_0)" -"(lambda(v_1 v2_0)" -"(begin 'temp95(make-rectangular v_1 v2_0)))))" -"(read-for-special-compound62.1" -" temp93_0" -" #f" -" s87_0" -" temp88_0" -" temp89_0" -" radix90_0" -" exactness91_0" -" convert-mode92_0" -" v94_0" -" temp95_0)))" -" c4_0)" -"(let-values(((c3_0)" -"(if(not in-complex_0)" -"(if(fx>=(fx- end_0 start_0) 7)" -"(if(char=? '#\\i(string-ref s_0(fx- end_0 1)))" -"(if(char-sign?(string-ref s_0(fx- end_0 7)))" -"(read-special-number" -" s_0" -"(fx- end_0 7)" -"(fx- end_0 1)" -" convert-mode_0)" -" #f)" -" #f)" -" #f)" -" #f)))" -"(if c3_0" -"((lambda(v2_0)" -"(if(if(fx= start_0(fx- end_0 7))(not(extflonum? v2_0)) #f)" -"(let-values()(make-rectangular 0 v2_0))" -"(let-values()" -"(let-values(((s96_0) s_0)" -"((start97_0) start_0)" -"((temp98_0)(fx- end_0 7))" -"((radix99_0) radix_0)" -"((exactness100_0) exactness_0)" -"((convert-mode101_0) convert-mode_0)" -"((temp102_0) 'i)" -"((temp103_0) #t)" -"((v2104_0) v2_0)" -"((temp105_0)" -"(lambda(v2_1 v_0)" -"(begin 'temp105(make-rectangular v_0 v2_1)))))" -"(read-for-special-compound62.1" -" temp102_0" -" temp103_0" -" s96_0" -" start97_0" -" temp98_0" -" radix99_0" -" exactness100_0" -" convert-mode101_0" -" v2104_0" -" temp105_0)))))" -" c3_0)" -"(let-values(((c2_0)" -"(if(char-sign? c_0)" -"(if(not in-complex_0)" -"(if(fx>(fx- end_0 start_0) 7)" -"(if(char=? '#\\@(string-ref s_0(fx+ start_0 6)))" -"(read-special-number" -" s_0" -" start_0" -"(fx+ start_0 6)" -" convert-mode_0)" -" #f)" -" #f)" -" #f)" -" #f)))" -"(if c2_0" -"((lambda(v_0)" -"(let-values(((s106_0) s_0)" -"((temp107_0)(fx+ start_0 7))" -"((end108_0) end_0)" -"((radix109_0) radix_0)" -"((exactness110_0) exactness_0)" -"((convert-mode111_0) convert-mode_0)" -"((temp112_0) '@)" -"((v113_0) v_0)" -"((temp114_0)" -"(lambda(v_1 v2_0)" -"(begin 'temp114(make-polar v_1 v2_0)))))" -"(read-for-special-compound62.1" -" temp112_0" -" #f" -" s106_0" -" temp107_0" -" end108_0" -" radix109_0" -" exactness110_0" -" convert-mode111_0" -" v113_0" -" temp114_0)))" -" c2_0)" -"(let-values(((c1_0)" -"(if(not in-complex_0)" -"(if(fx>(fx- end_0 start_0) 7)" -"(if(char=? '#\\@(string-ref s_0(fx- end_0 7)))" -"(read-special-number" -" s_0" -"(fx- end_0 6)" -" end_0" -" convert-mode_0)" -" #f)" -" #f)" -" #f)))" -"(if c1_0" -"((lambda(v2_0)" -"(let-values(((s115_0) s_0)" -"((start116_0) start_0)" -"((temp117_0)(fx- end_0 7))" -"((radix118_0) radix_0)" -"((exactness119_0) exactness_0)" -"((convert-mode120_0) convert-mode_0)" -"((temp121_0) '@)" -"((temp122_0) #t)" -"((v2123_0) v2_0)" -"((temp124_0)" -"(lambda(v2_1 v_0)" -"(begin 'temp124(make-polar v_0 v2_1)))))" -"(read-for-special-compound62.1" -" temp121_0" -" temp122_0" -" s115_0" -" start116_0" -" temp117_0" -" radix118_0" -" exactness119_0" -" convert-mode120_0" -" v2123_0" -" temp124_0)))" -" c1_0)" -"(let-values()" -"(let-values(((s125_0) s_0)" -"((start126_0) start_0)" -"((end127_0) end_0)" -"((radix128_0) radix_0)" -"((radix-set?129_0) radix-set?_0)" -"((exactness130_0) exactness_0)" -"((in-complex131_0) in-complex_0)" -"((convert-mode132_0) convert-mode_0))" -"(do-string->non-special-number30.1" -" in-complex131_0" -" radix-set?129_0" -" s125_0" -" start126_0" -" end127_0" -" radix128_0" -" exactness130_0" -" convert-mode132_0)))))))))))))))))))))))))))))" -"(define-values" -"(do-string->non-special-number30.1)" -"(lambda(in-complex21_0 radix-set?20_0 s24_0 start25_0 end26_0 radix27_0 exactness28_0 convert-mode29_0)" -"(begin" -" 'do-string->non-special-number30" -"(let-values(((s_0) s24_0))" -"(let-values(((start_0) start25_0))" -"(let-values(((end_0) end26_0))" -"(let-values(((radix_0) radix27_0))" -"(let-values(((radix-set?_0) radix-set?20_0))" -"(let-values(((exactness_0) exactness28_0))" -"(let-values(((in-complex_0) in-complex21_0))" -"(let-values(((convert-mode_0) convert-mode29_0))" -"(let-values()" -"((letrec-values(((loop_0)" -"(lambda(i_0" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" dot-pos_0" -" slash-pos_0" -" exp-pos_0" -" must-i?_0)" -"(begin" -" 'loop" -"(if(fx= i_0 end_0)" -"(let-values()" -"(if(if(not any-digits?_0)(not i-pos_0) #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"no digits in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(if must-i?_0(not i-pos_0) #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" +"(if(eq?" +"(state->convert-mode" +"(if(eq? convert-mode_0 'read) 'must-read convert-mode_0))" +" 'must-read)" "(let-values()" "(format" -" \"too many signs in `~.a`\"" +" \"bad `#` indicator `~a` at `~.a`\"" +" i_0" "(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(if sign-pos_0" -"(let-values(((or-part_0)" -"(if dot-pos_0(fx< dot-pos_0 sign-pos_0) #f)))" -"(if or-part_0" -" or-part_0" -"(if slash-pos_0(fx< slash-pos_0 sign-pos_0) #f)))" -" #f)" +"(let-values() #f)))))))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))(if or-part_0 or-part_0 #f))" "(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"misplaced sign in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if i-pos_0" -"(let-values()" -"(let-values(((s133_0) s_0)" -"((start134_0) start_0)" -"((sign-pos135_0) sign-pos_0)" -"((sign-pos136_0) sign-pos_0)" -"((temp137_0)(fx- end_0 1))" -"((i-pos138_0) i-pos_0)" -"((sign-pos139_0) sign-pos_0)" -"((radix140_0) radix_0)" -"((radix-set?141_0) radix-set?_0)" -"((exactness142_0) exactness_0)" -"((temp143_0) 'i)" -"((convert-mode144_0) convert-mode_0))" -"(string->complex-number47.1" -" temp143_0" -" radix-set?141_0" -" s133_0" -" start134_0" -" sign-pos135_0" -" sign-pos136_0" -" temp137_0" -" i-pos138_0" -" sign-pos139_0" -" radix140_0" -" exactness142_0" -" convert-mode144_0)))" -"(if @-pos_0" -"(let-values()" -"(let-values(((s145_0) s_0)" -"((start146_0) start_0)" -"((@-pos147_0) @-pos_0)" -"((temp148_0)(fx+ 1 @-pos_0))" -"((end149_0) end_0)" -"((i-pos150_0) i-pos_0)" -"((sign-pos151_0) sign-pos_0)" -"((radix152_0) radix_0)" -"((radix-set?153_0) radix-set?_0)" -"((exactness154_0) exactness_0)" -"((temp155_0) '@)" -"((convert-mode156_0) convert-mode_0))" -"(string->complex-number47.1" -" temp155_0" -" radix-set?153_0" -" s145_0" -" start146_0" -" @-pos147_0" -" temp148_0" -" end149_0" -" i-pos150_0" -" sign-pos151_0" -" radix152_0" -" exactness154_0" -" convert-mode156_0)))" -"(let-values()" -"(string->real-number" +"(read-signed" +" 1" " s_0" -" start_0" +"(fx+ 1 start_0)" " end_0" -" dot-pos_0" -" slash-pos_0" -" exp-pos_0" -" any-hashes?_0" " radix_0" -" exactness_0" -" convert-mode_0))))))))" +"(init-state exactness_0 convert-mode_0 '+/-)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\-)))(if or-part_0 or-part_0 #f))" "(let-values()" -"(let-values(((c_0)(string-ref s_0 i_0)))" -"(if(digit? c_0 radix_0)" +"(read-signed" +" -1" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(init-state exactness_0 convert-mode_0 '+/-)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))" "(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" #t" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" dot-pos_0" -" slash-pos_0" -" exp-pos_0" -" must-i?_0))" -"(if(char=? c_0 '#\\#)" -"(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" #t" -" #t" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" dot-pos_0" -" slash-pos_0" -" exp-pos_0" -" must-i?_0))" -"(if(char-sign? c_0)" -"(let-values()" -"(if(if sign-pos_0 must-i?_0 #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"too many signs in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" i_0" -" dot-pos_0" -" slash-pos_0" +"(read-decimal" +" 1" " #f" -"(if(fx> i_0 start_0)" -"(let-values(((or-part_0)(not @-pos_0)))" -"(if or-part_0 or-part_0(fx> i_0(fx+ 1 @-pos_0))))" -" #f)))))" -"(if(char=? c_0 '#\\.)" +" 0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((temp78_0)(init-state exactness_0 convert-mode_0 #f))" +"((temp79_0) 'approx))" +"(set-exactness23.1 #f temp78_0 temp79_0))))" +"(let-values()(bad-digit c_0 s_0 convert-mode_0))))))))))))))))))))" +"(define-values" +"(read-signed)" +"(lambda(sgn_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(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()" -"(if(let-values(((or-part_0)" -"(if exp-pos_0" -"(let-values(((or-part_0)" -"(not sign-pos_0)))" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"no digits in `~.a`\" s_0))" +"(let-values() #f)))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +"(let-values()(read-integer sgn_0 c_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" +" #f" +" 0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state80_0) state_0)((temp81_0) 'approx))(set-exactness23.1 #f state80_0 temp81_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))" +"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\I)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(let-values(((c2_0)" +"(if(fx=(fx+ 1 start_0) end_0)" +" 'eof" +"(let-values(((c_1)(string-ref s_0(fx+ 1 start_0))))(maybe-digit c_1 radix_0)))))" +"(if(let-values(((or-part_0)(eqv? c2_0 'eof)))(if or-part_0 or-part_0 #f))" +"(let-values()(finish-imaginary sgn_0 sgn_0 s_0(fx+ 1 start_0) end_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\n)))" "(if or-part_0" " or-part_0" -"(fx> exp-pos_0 sign-pos_0)))" -" #f)))" +"(let-values(((or-part_1)(eqv? c2_0 '#\\N)))(if or-part_1 or-part_1 #f))))" +"(let-values()(read-infinity sgn_0 c_0 s_0(fx+ 2 start_0) end_0 radix_0 state_0))" +"(let-values()(bad-digit c_0 s_0 state_0))))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\n)))" +"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\N)))(if or-part_1 or-part_1 #f))))" +"(let-values()(read-nan c_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0))" +"(let-values()(bad-digit c_0 s_0 state_0)))))))))))" +"(define-values" +"(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(((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()(finish sgn_0(get-n_0) s_0 state_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))" +"(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" +" 0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state82_0) state_0)((temp83_0) 'approx))(set-exactness23.1 #f state82_0 temp83_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" "(if or-part_0" " or-part_0" -"(if dot-pos_0" -"(let-values(((or-part_1)(not sign-pos_0)))" +"(let-values(((or-part_1)(eqv? c_0 '#\\E)))" "(if or-part_1" " or-part_1" -"(fx> dot-pos_0 sign-pos_0)))" -" #f)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"misplaced `.` in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(if slash-pos_0" -"(let-values(((or-part_0)(not sign-pos_0)))" -"(if or-part_0" -" or-part_0" -"(fx> slash-pos_0 sign-pos_0)))" -" #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"decimal points and fractions cannot be mixed `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" i_0" -" #f" -" #f" -" must-i?_0)))))" -"(if(char=? c_0 '#\\/)" -"(let-values()" -"(if(if dot-pos_0" -"(let-values(((or-part_0)(not sign-pos_0)))" -"(if or-part_0" -" or-part_0" -"(fx> dot-pos_0 sign-pos_0)))" -" #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"decimal points and fractions cannot be mixed `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(let-values(((or-part_0)" -"(if exp-pos_0" -"(let-values(((or-part_0)" -"(not sign-pos_0)))" -"(if or-part_0" -" or-part_0" -"(fx> exp-pos_0 sign-pos_0)))" -" #f)))" -"(if or-part_0" -" or-part_0" -"(if slash-pos_0" -"(let-values(((or-part_1)(not sign-pos_0)))" -"(if or-part_1" -" or-part_1" -"(fx> slash-pos_0 sign-pos_0)))" -" #f)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"misplaced `/` in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" #f" -" i_0" -" #f" -" must-i?_0)))))" -"(if(let-values(((or-part_0)(char=? c_0 '#\\e)))" -"(if or-part_0" -" or-part_0" -"(let-values(((or-part_1)(char=? c_0 '#\\E)))" -"(if or-part_1" -" or-part_1" -"(let-values(((or-part_2)(char=? c_0 '#\\f)))" +"(let-values(((or-part_2)(eqv? c_0 '#\\d)))" "(if or-part_2" " or-part_2" -"(let-values(((or-part_3)" -"(char=? c_0 '#\\F)))" +"(let-values(((or-part_3)(eqv? c_0 '#\\D)))" "(if or-part_3" " or-part_3" -"(let-values(((or-part_4)" -"(char=? c_0 '#\\d)))" +"(let-values(((or-part_4)(eqv? c_0 '#\\l)))" "(if or-part_4" " or-part_4" -"(let-values(((or-part_5)" -"(char=? c_0 '#\\D)))" +"(let-values(((or-part_5)(eqv? c_0 '#\\L)))" "(if or-part_5" " or-part_5" -"(let-values(((or-part_6)" -"(char=?" -" c_0" -" '#\\s)))" +"(let-values(((or-part_6)(eqv? c_0 '#\\f)))" "(if or-part_6" " or-part_6" -"(let-values(((or-part_7)" -"(char=?" -" c_0" -" '#\\S)))" +"(let-values(((or-part_7)(eqv? c_0 '#\\F)))" "(if or-part_7" " or-part_7" -"(let-values(((or-part_8)" -"(char=?" -" c_0" -" '#\\l)))" +"(let-values(((or-part_8)(eqv? c_0 '#\\s)))" "(if or-part_8" " or-part_8" -"(let-values(((or-part_9)" -"(char=?" -" c_0" -" '#\\L)))" +"(let-values(((or-part_9)(eqv? c_0 '#\\S)))" "(if or-part_9" " or-part_9" -"(let-values(((or-part_10)" -"(char=?" -" c_0" -" '#\\t)))" +"(let-values(((or-part_10)(eqv? c_0 '#\\t)))" "(if or-part_10" " or-part_10" -"(char=?" -" c_0" -" '#\\T)))))))))))))))))))))))" +"(let-values(((or-part_11)(eqv? c_0 '#\\T)))" +"(if or-part_11 or-part_11 #f))))))))))))))))))))))))" "(let-values()" -"(if exp-pos_0" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"misplaced `~a` in `~.a`\"" -" c_0" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(if(fx<(fx+ 1 i_0) end_0)" -"(char-sign?(string-ref s_0(fx+ 1 i_0)))" -" #f)" -"(let-values()" -"(loop_0" -"(fx+ i_0 2)" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" dot-pos_0" -" slash-pos_0" -"(let-values(((or-part_0) exp-pos_0))" -"(if or-part_0 or-part_0 i_0))" -" must-i?_0))" -"(let-values()" -"(loop_0" -"(fx+ i_0 1)" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" @-pos_0" -" sign-pos_0" -" dot-pos_0" -" slash-pos_0" -"(let-values(((or-part_0) exp-pos_0))" -"(if or-part_0 or-part_0 i_0))" -" must-i?_0)))))" -"(if(char=? c_0 '#\\@)" -"(let-values()" -"(if(eq? in-complex_0 'i)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"cannot mix `@` and `i` in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(let-values(((or-part_0) @-pos_0))" -"(if or-part_0" -" or-part_0" -"(eq? in-complex_0 '@)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"too many `@`s in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(fx= i_0 start_0)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"`@` cannot be at start in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if must-i?_0" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"too many signs in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" any-digits?_0" -" any-hashes?_0" -" i-pos_0" -" i_0" -" #f" -" #f" -" #f" -" #f" -" must-i?_0)))))))" -"(if(if(let-values(((or-part_0)(char=? c_0 '#\\i)))" -"(if or-part_0 or-part_0(char=? c_0 '#\\I)))" -" sign-pos_0" -" #f)" -"(let-values()" -"(if(let-values(((or-part_0) @-pos_0))" -"(if or-part_0" -" or-part_0" -"(eq? in-complex_0 '@)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"cannot mix `@` and `i` in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(let-values(((or-part_0)" -"(fx<(fx+ 1 i_0) end_0)))" -"(if or-part_0" -" or-part_0" -"(eq? in-complex_0 'i)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"`i` must be at the end in `~.a`\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(loop_0" -"(fx+ 1 i_0)" -" any-digits?_0" -" any-hashes?_0" -" i_0" -" @-pos_0" -" sign-pos_0" -" #f" -" #f" -" #f" -" #f)))))" -"(let-values()" -"(if(char=? c_0 '#\\nul)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"nul character in `~.a`\" s_0))" -"(let-values() #f)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"bad digit `~a`\" c_0))" -"(let-values() #f))))))))))))))))))))" -" loop_0)" -" start_0" -" #f" -" #f" -" #f" -" #f" -" #f" -" #f" -" #f" -" #f" -" #f)))))))))))))" -"(define-values" -"(string->complex-number47.1)" -"(lambda(in-complex34_0" -" radix-set?33_0" -" s37_0" -" start138_0" -" end139_0" -" start240_0" -" end241_0" -" i-pos42_0" -" sign-pos43_0" -" radix44_0" -" exactness45_0" -" convert-mode46_0)" -"(begin" -" 'string->complex-number47" -"(let-values(((s_0) s37_0))" -"(let-values(((start1_0) start138_0))" -"(let-values(((end1_0) end139_0))" -"(let-values(((start2_0) start240_0))" -"(let-values(((end2_0) end241_0))" -"(let-values()" -"(let-values()" -"(let-values(((radix_0) radix44_0))" -"(let-values(((radix-set?_0) radix-set?33_0))" -"(let-values(((exactness_0) exactness45_0))" -"(let-values(((in-complex_0) in-complex34_0))" -"(let-values(((convert-mode_0) convert-mode46_0))" -"(let-values()" -"(let-values(((v1_0)" -"(if(fx= start1_0 end1_0)" -"(let-values()(if(eq? exactness_0 'inexact) 0.0 0))" -"(let-values()" -"(let-values(((s157_0) s_0)" -"((start1158_0) start1_0)" -"((end1159_0) end1_0)" -"((radix160_0) radix_0)" -"((radix-set?161_0) radix-set?_0)" -"((exactness162_0) exactness_0)" -"((in-complex163_0) in-complex_0)" -"((convert-mode164_0) convert-mode_0))" -"(do-string->number17.1" -" in-complex163_0" -" radix-set?161_0" -" s157_0" -" start1158_0" -" end1159_0" -" radix160_0" -" exactness162_0" -" convert-mode164_0))))))" -"(let-values(((v2_0)" -"(if(if(eq? in-complex_0 'i)(fx=(fx- end2_0 start2_0) 1) #f)" -"(let-values()" -"(let-values(((neg?_0)(char=?(string-ref s_0 start2_0) '#\\-)))" -"(if(eq? exactness_0 'inexact)" -"(let-values()(if neg?_0 -1.0 1.0))" -"(let-values()(if neg?_0 -1 1)))))" -"(let-values()" -"(let-values(((s165_0) s_0)" -"((start2166_0) start2_0)" -"((end2167_0) end2_0)" -"((radix168_0) radix_0)" -"((radix-set?169_0) radix-set?_0)" -"((exactness170_0) exactness_0)" -"((in-complex171_0) in-complex_0)" -"((convert-mode172_0) convert-mode_0))" -"(do-string->number17.1" -" in-complex171_0" -" radix-set?169_0" -" s165_0" -" start2166_0" -" end2167_0" -" radix168_0" -" exactness170_0" -" convert-mode172_0))))))" -"(if(let-values(((or-part_0)(not v1_0)))(if or-part_0 or-part_0(not v2_0)))" -"(let-values() #f)" -"(if(if(let-values(((or-part_0)(extflonum? v1_0)))" -"(if or-part_0 or-part_0(extflonum? v2_0)))" -"(not(eq? convert-mode_0 'must-read))" -" #f)" -"(let-values()(fail-extflonum convert-mode_0 v1_0))" -"(if(string? v1_0)" -"(let-values() v1_0)" -"(if(extflonum? v1_0)" -"(let-values()(fail-extflonum convert-mode_0 v1_0))" -"(if(string? v2_0)" -"(let-values() v2_0)" -"(if(extflonum? v2_0)" -"(let-values()(fail-extflonum convert-mode_0 v2_0))" -"(if(eq? in-complex_0 'i)" -"(let-values()(make-rectangular v1_0 v2_0))" -"(let-values()" -"(let-values(((p_0)(make-polar v1_0 v2_0)))" -"(if(eq? exactness_0 'exact)" -"(inexact->exact p_0)" -" p_0))))))))))))))))))))))))))))" -"(define-values" -"(string->real-number)" -"(lambda(s_0 start_0 end_0 dot-pos_0 slash-pos_0 exp-pos_0 any-hashes?_0 radix_0 exactness_0 convert-mode_0)" -"(begin" -"(let-values(((extfl-mark?_0)" -"(lambda()(begin 'extfl-mark?(char=?(char-downcase(string-ref s_0 exp-pos_0)) '#\\t)))))" -"(let-values(((simple?_0)" -"(if(not slash-pos_0)" -"(if(let-values(((or-part_0)(eq? exactness_0 'inexact)))" -"(if or-part_0" -" or-part_0" -"(let-values(((or-part_1)(eq? exactness_0 'decimal-as-inexact)))" -"(if or-part_1 or-part_1(if(not dot-pos_0)(not exp-pos_0) #f)))))" -"(if(let-values(((or-part_0)(not exp-pos_0)))" -"(if or-part_0" -" or-part_0" -"(let-values(((or-part_1)(not(eq? convert-mode_0 'number-or-false))))" -"(if or-part_1 or-part_1(not(extfl-mark?_0))))))" -"(not(if any-hashes?_0(hashes? s_0 start_0 end_0) #f))" -" #f)" -" #f)" -" #f)))" -"(let-values(((has-sign?_0)(if(fx> end_0 start_0)(char-sign?(string-ref s_0 start_0)) #f)))" -"(if(fx=(fx- end_0 start_0)(fx+(if dot-pos_0 1 0)(if exp-pos_0 1 0)(if has-sign?_0 1 0)))" -"(let-values()" -"(if(fx= end_0 start_0)" -" (if (eq? convert-mode_0 'must-read) (let-values () (format \"missing digits\")) (let-values () #f))" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"missing digits in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f))))" -"(if simple?_0" -"(let-values()" -"(if(if exp-pos_0" -"(fx=" -"(fx- exp-pos_0 start_0)" -"(fx+(if(if dot-pos_0(fx< dot-pos_0 exp-pos_0) #f) 1 0)(if has-sign?_0 1 0)))" -" #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"missing digits before exponent marker in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(if exp-pos_0" -"(let-values(((or-part_0)(fx= exp-pos_0(fx- end_0 1))))" -"(if or-part_0" -" or-part_0" -"(if(fx= exp-pos_0(fx- end_0 2))(char-sign?(string-ref s_0(fx- end_0 1))) #f)))" -" #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"missing digits after exponent marker in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(let-values(((n_0)" -"(string->number$1" -"(maybe-substring s_0 start_0 end_0)" -" radix_0" -"(if(let-values(((or-part_0)(eq? convert-mode_0 'number-or-false)))" -"(if or-part_0" -" or-part_0" -"(let-values(((or-part_1)(not exp-pos_0)))" -"(if or-part_1 or-part_1(not(extfl-mark?_0))))))" -" 'number-or-false" -" 'read))))" -"(if(let-values(((or-part_0)(not n_0)))(if or-part_0 or-part_0(string? n_0)))" -"(let-values()" -"(error" -" 'string->number" -" \"host `string->number` failed on ~s with radix ~s\"" -"(substring s_0 start_0 end_0)" -" radix_0))" -"(if(eq? exactness_0 'inexact)" -"(let-values()" -"(if(extflonum? n_0)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"cannot convert extflonum `~.a` to inexact\"" -"(substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(if(if(eqv? n_0 0)(char=?(string-ref s_0 start_0) '#\\-) #f)" -"(let-values() -0.0)" -"(let-values()(exact->inexact n_0)))))" -"(let-values() n_0))))))))" -"(if exp-pos_0" -"(let-values()" -"(let-values(((m-v_0)" -"(string->real-number" +"(read-exponent" +" sgn_0" +"(get-n_0)" +" 0" " s_0" -" start_0" -" exp-pos_0" -" dot-pos_0" -" slash-pos_0" -" #f" -" any-hashes?_0" -" radix_0" -" 'exact" -" convert-mode_0)))" -"(let-values(((e-v_0)" -"(string->exact-integer-number s_0(fx+ exp-pos_0 1) end_0 radix_0 convert-mode_0)))" -"(let-values(((real->precision-inexact_0)" -"(lambda(r_0)" -"(begin" -" 'real->precision-inexact" -"(let-values(((tmp_0)(string-ref s_0 exp-pos_0)))" -"(if(if(equal? tmp_0 '#\\s)" -" #t" -"(if(equal? tmp_0 '#\\S)" -" #t" -"(if(equal? tmp_0 '#\\f) #t(equal? tmp_0 '#\\F))))" -"(let-values()(real->single-flonum r_0))" -"(if(if(equal? tmp_0 '#\\t) #t(equal? tmp_0 '#\\T))" -"(let-values()" -"(if(extflonum-available?)" -"(real->extfl r_0)" -"(string->number$1" -"(replace-hashes s_0 start_0 end_0)" -" radix_0" -" 'read)))" -"(let-values()(real->double-flonum r_0)))))))))" -"(let-values(((get-extfl?_0)(extfl-mark?_0)))" -"(if(let-values(((or-part_0)(not m-v_0)))(if or-part_0 or-part_0(not e-v_0)))" -"(let-values() #f)" -"(if(string? m-v_0)" -"(let-values() m-v_0)" -"(if(string? e-v_0)" -"(let-values() e-v_0)" -"(if(if(eq? convert-mode_0 'number-or-false) get-extfl?_0 #f)" -"(let-values() #f)" -"(if(if(let-values(((or-part_0)(eq? exactness_0 'inexact)))" -"(if or-part_0 or-part_0(eq? exactness_0 'decimal-as-inexact)))" -"(let-values(((m-v-e_0)" -"(/" -"(-" -"(integer-length(numerator m-v_0))" -"(integer-length(denominator m-v_0)))" -"(log radix_0 2))))" -"(>(abs(+ e-v_0 m-v-e_0))(if get-extfl?_0(expt 2 15)(expt 2 11))))" -" #f)" -"(let-values()" -"(real->precision-inexact_0" -"(if(eqv? m-v_0 0)" -"(let-values()(if(char=?(string-ref s_0 start_0) '#\\-) -0.0 0.0))" -"(if(positive? m-v_0)" -"(let-values()(if(positive? e-v_0) +inf.0 0.0))" -"(let-values()(if(positive? e-v_0) -inf.0 -0.0))))))" -"(if(if(exactness-set? exactness_0) get-extfl?_0 #f)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -"(format" -" \"cannot convert extflonum `~.a` to ~a\"" -"(substring s_0 start_0 end_0)" -" exactness_0))" -"(let-values() #f)))" -"(let-values()" -"(let-values(((n_0)(* m-v_0(expt radix_0 e-v_0))))" -"(if(if(not get-extfl?_0)" -"(let-values(((or-part_0)(eq? exactness_0 'exact)))" -"(if or-part_0 or-part_0(eq? exactness_0 'decimal-as-exact)))" -" #f)" -"(let-values() n_0)" -"(if(if(eqv? n_0 0)(char=?(string-ref s_0 start_0) '#\\-) #f)" -"(let-values()(real->precision-inexact_0 -0.0))" -"(let-values()(real->precision-inexact_0 n_0)))))))))))))))))" -"(if slash-pos_0" -"(let-values()" -"(let-values(((n-v_0)" -"(string->real-number" -" s_0" -" start_0" -" slash-pos_0" -" #f" -" #f" -" #f" -" any-hashes?_0" -" radix_0" -" 'exact" -" convert-mode_0)))" -"(let-values(((d-v_0)" -"(string->real-number" -" s_0" -"(fx+ 1 slash-pos_0)" +"(fx+ 1 start_0)" " end_0" -" #f" -" #f" -" #f" -" any-hashes?_0" " radix_0" -" 'exact" -" convert-mode_0)))" -"(let-values(((get-inexact?_0)" -"(lambda(from-pos_0)" -"(begin" -" 'get-inexact?" -"(let-values(((or-part_0)(eq? exactness_0 'inexact)))" +"(let-values(((state84_0) state_0)((c85_0) c_0))(set-exactness-by-char30.1 #f state84_0 c85_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" +"(let-values()(read-rational sgn_0(get-n_0) #f 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-approx" +" sgn_0" +" n_0" +" 1" +" #f" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state86_0) state_0)((temp87_0) 'approx))" +"(set-exactness23.1 #f state86_0 temp87_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" "(if or-part_0" " or-part_0" -"(if(not" -"(let-values(((or-part_1)(eq? exactness_0 'exact)))" -"(if or-part_1 or-part_1(eq? exactness_0 'decimal-as-exact))))" -"(hashes? s_0 from-pos_0 end_0)" -" #f)))))))" -"(if(let-values(((or-part_0)(not n-v_0)))(if or-part_0 or-part_0(not d-v_0)))" -"(let-values() #f)" -"(if(string? n-v_0)" -"(let-values() n-v_0)" -"(if(string? d-v_0)" -"(let-values() d-v_0)" -"(if(eqv? d-v_0 0)" +"(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" "(let-values()" -"(if(get-inexact?_0(fx+ 1 slash-pos_0))" -"(let-values()(if(negative? n-v_0) -inf.0 +inf.0))" -"(let-values()" -"(if(eq?(read-complains convert-mode_0) 'must-read)" -"(let-values()" -" (format \"division by zero in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))))" -"(let-values()" -"(let-values(((n_0)(/ n-v_0 d-v_0)))" -"(if(get-inexact?_0 start_0)(exact->inexact n_0) n_0)))))))))))" -"(let-values()" -"(string->decimal-number s_0 start_0 end_0 dot-pos_0 radix_0 exactness_0 convert-mode_0))))))))))))" +"(read-imag" +" c_0" +" sgn_0" +"(get-n_0)" +"(if(eqv? c_0 '#\\+) 1 -1)" +" 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-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))" +"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))" "(define-values" -"(string->decimal-number)" -"(lambda(s_0 start_0 end_0 dot-pos_0 radix_0 exactness_0 convert-mode_0)" +"(read-decimal)" +"(lambda(sgn_0 n_0 exp_0 s_0 start_0 end_0 radix_0 state_0)" "(begin" -"(let-values(((get-exact?_0)" -"(let-values(((or-part_0)(eq? exactness_0 'exact)))" -"(if or-part_0 or-part_0(eq? exactness_0 'decimal-as-exact)))))" -"(let-values(((new-str_0)(make-string(fx- end_0 start_0(if(if dot-pos_0 get-exact?_0 #f) 1 0)))))" -"((letrec-values(((loop_0)" -"(lambda(i_0 j_0 hashes-pos_0)" +"(let-values(((get-n_0)" +"(lambda()" "(begin" -" 'loop" -"(if(fx< i_0 start_0)" +" 'get-n" +" (if n_0 (lazy-number (* sgn_0 n_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()" -"(if(fx= hashes-pos_0 start_0)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"misplaced `#` in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(let-values(((n_0)(string->number$1 new-str_0 radix_0)))" -"(if(not n_0)" -"(let-values()(fail-bad-number convert-mode_0 s_0 start_0 end_0))" -"(if(not get-exact?_0)" -"(let-values()" -"(if(if(eqv? n_0 0)(char=?(string-ref s_0 start_0) '#\\-) #f)" -" -0.0" -"(exact->inexact n_0)))" -"(if(if dot-pos_0 get-exact?_0 #f)" -"(let-values()(/ n_0(expt 10(fx- end_0 dot-pos_0 1))))" -"(let-values() n_0))))))))" -"(let-values()" -"(let-values(((c_0)(string-ref s_0 i_0)))" -"(if(char=? c_0 '#\\.)" -"(let-values()" -"(if get-exact?_0" -"(let-values()" -"(loop_0" -"(fx- i_0 1)" -" j_0" -"(if(fx= hashes-pos_0(fx+ 1 i_0)) i_0 hashes-pos_0)))" -"(let-values()" -"(begin" -"(string-set! new-str_0 j_0 c_0)" -"(loop_0" -"(fx- i_0 1)" -"(fx- j_0 1)" -"(if(fx= hashes-pos_0(fx+ 1 i_0)) i_0 hashes-pos_0))))))" -"(if(let-values(((or-part_0)(char=? c_0 '#\\-)))" -"(if or-part_0 or-part_0(char=? c_0 '#\\+)))" -"(let-values()" -"(begin" -"(string-set! new-str_0 j_0 c_0)" -"(loop_0" -"(fx- i_0 1)" -"(fx- j_0 1)" -"(if(fx= hashes-pos_0(fx+ 1 i_0)) i_0 hashes-pos_0))))" -"(if(char=? c_0 '#\\#)" -"(let-values()" -"(if(fx= hashes-pos_0(fx+ 1 i_0))" -"(let-values()" -"(begin" -"(string-set! new-str_0 j_0 '#\\0)" -"(loop_0(fx- i_0 1)(fx- j_0 1) i_0)))" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -"(let-values()" -" (format \"misplaced `#` in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))))" -"(let-values()" -"(begin" -"(string-set! new-str_0 j_0 c_0)" -"(loop_0(fx- i_0 1)(fx- j_0 1) hashes-pos_0)))))))))))))" -" loop_0)" -"(fx- end_0 1)" -"(fx-(string-length new-str_0) 1)" -" end_0))))))" -"(define-values" -"(string->exact-integer-number)" -"(lambda(s_0 start_0 end_0 radix_0 convert-mode_0)" -"(begin" -"(if(hashes? s_0 start_0 end_0)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"misplaced `#` in `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values()" -"(let-values(((n_0)(string->number$1(maybe-substring s_0 start_0 end_0) radix_0)))" -"(if(not n_0)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"bad exponent `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))" -"(let-values() n_0))))))))" -"(define-values" -"(read-special-number)" -"(lambda(s_0 start_0 end_0 convert-mode_0)" -"(begin" -"(if(fx=(fx- end_0 start_0) 6)" -"(if(let-values(((or-part_0)(char=?(string-ref s_0 start_0) '#\\+)))" -"(if or-part_0 or-part_0(char=?(string-ref s_0 start_0) '#\\-)))" -"(let-values(((or-part_0)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 1))) '#\\i)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 2))) '#\\n)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 3))) '#\\f)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 4))) '#\\.)" -"(let-values(((or-part_0)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\0)" -"(if(char=?(string-ref s_0 start_0) '#\\+) +inf.0 -inf.0)" -" #f)))" +"(let-values(((or-part_0)(if n_0(fast-inexact state_0 sgn_0 n_0 radix_0 0 -1 exp_0) #f)))" "(if or-part_0" " or-part_0" -"(let-values(((or-part_1)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\f)" -"(if(char=?(string-ref s_0 start_0) '#\\+) +inf.f -inf.f)" -" #f)))" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_1)(not v_0)))(if or-part_1 or-part_1(string? v_0)))" +" v_0" +"((lambda(n_1)(finish sgn_0 n_1 s_0 state_0)) v_0))))))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((next_0)(fx+ 1 start_0)))" +"(if(if(eqv? c_0 '#\\0)(fx= next_0 end_0) #f)" +"(let-values()" +"(read-decimal" +" sgn_0" +"(let-values(((or-part_0) n_0))(if or-part_0 or-part_0 0))" +" exp_0" +" s_0" +" next_0" +" end_0" +" radix_0" +" state_0))" +"(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)" +"(fx+ 1 exp_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 () (bad-misplaced \".\" s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\E)))" "(if or-part_1" " or-part_1" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\t)" -"(if(not(eq? convert-mode_0 'number-or-false))" -"(if(char=?(string-ref s_0 start_0) '#\\+) '+inf.t '-inf.t)" -" #f)" -" #f)))))" -" #f)" -" #f)" -" #f)" -" #f)))" -"(if or-part_0" -" or-part_0" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 1))) '#\\n)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 2))) '#\\a)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 3))) '#\\n)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 4))) '#\\.)" -"(let-values(((or-part_1)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\0) +nan.0 #f)))" -"(if or-part_1" -" or-part_1" -"(let-values(((or-part_2)" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\f) +nan.f #f)))" +"(let-values(((or-part_2)(eqv? c_0 '#\\d)))" "(if or-part_2" " or-part_2" -"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\t)" -"(if(not(eq? convert-mode_0 'number-or-false)) '+nan.t #f)" -" #f)))))" -" #f)" -" #f)" -" #f)" -" #f)))" -" #f)" -" #f))))" -"(define-values" -"(fail-extflonum)" -"(lambda(convert-mode_0 v_0)" -"(begin" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"cannot combine extflonum `~a` into complex number\" v_0))" -"(let-values() #f)))))" -"(define-values" -"(read-for-special-compound62.1)" -"(lambda(in-complex50_0" -" reading-first?51_0" -" s54_0" -" start55_0" -" end56_0" -" radix57_0" -" exactness58_0" -" convert-mode59_0" -" v60_0" -" combine61_0)" -"(begin" -" 'read-for-special-compound62" -"(let-values(((s_0) s54_0))" -"(let-values(((start_0) start55_0))" -"(let-values(((end_0) end56_0))" -"(let-values(((radix_0) radix57_0))" -"(let-values(((exactness_0) exactness58_0))" -"(let-values(((convert-mode_0) convert-mode59_0))" -"(let-values(((in-complex_0) in-complex50_0))" -"(let-values(((reading-first?_0) reading-first?51_0))" -"(let-values(((v_0) v60_0))" -"(let-values(((combine_0) combine61_0))" +"(let-values(((or-part_3)(eqv? c_0 '#\\D)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? c_0 '#\\l)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? c_0 '#\\L)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? c_0 '#\\f)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? c_0 '#\\F)))" +"(if or-part_7" +" or-part_7" +"(let-values(((or-part_8)(eqv? c_0 '#\\s)))" +"(if or-part_8" +" or-part_8" +"(let-values(((or-part_9)(eqv? c_0 '#\\S)))" +"(if or-part_9" +" or-part_9" +"(let-values(((or-part_10)(eqv? c_0 '#\\t)))" +"(if or-part_10" +" or-part_10" +"(let-values(((or-part_11)(eqv? c_0 '#\\T)))" +"(if or-part_11 or-part_11 #f))))))))))))))))))))))))" "(let-values()" -"(if(eq? exactness_0 'exact)" -"(let-values()" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"no exact representation for `~a`\" v_0))" -"(let-values() #f)))" -"(if(if(extflonum? v_0)" -"(let-values(((or-part_0)(not reading-first?_0)))" -"(if or-part_0 or-part_0(not(eq? convert-mode_0 'must-read))))" -" #f)" -"(let-values()(fail-extflonum convert-mode_0 v_0))" -"(let-values()" -"(let-values(((v2_0)" -"(let-values(((s173_0) s_0)" -"((start174_0) start_0)" -"((end175_0) end_0)" -"((radix176_0) radix_0)" -"((temp177_0) #t)" -"((exactness178_0) exactness_0)" -"((in-complex179_0) in-complex_0)" -"((convert-mode180_0) convert-mode_0))" -"(do-string->number17.1" -" in-complex179_0" -" temp177_0" -" s173_0" -" start174_0" -" end175_0" -" radix176_0" -" exactness178_0" -" convert-mode180_0))))" -"(if(string? v2_0)" -"(let-values() v2_0)" -"(if(not v2_0)" -"(let-values() v2_0)" -"(if(extflonum? v_0)" -"(let-values()(fail-extflonum convert-mode_0 v_0))" -"(let-values()(combine_0 v_0 v2_0)))))))))))))))))))))))" -"(define-values" -"(hashes?)" -"(lambda(s_0 start_0 end_0)" -"(begin" -"(let-values(((v*_0 start*_0 stop*_0 step*_0)" -"(normalise-inputs" -" 'in-string" -" \"string\"" -"(lambda(x_0)(string? x_0))" -"(lambda(x_0)(unsafe-string-length x_0))" +"(if n_0" +"(read-exponent" +" sgn_0" +"(* sgn_0 n_0)" +"(- exp_0)" " s_0" -" start_0" +"(fx+ 1 start_0)" " end_0" -" 1)))" -"(begin" -" #t" -"((letrec-values(((for-loop_0)" -"(lambda(result_0 idx_0)" -"(begin" -" 'for-loop" -"(if(unsafe-fx< idx_0 stop*_0)" -"(let-values(((c_0)(string-ref v*_0 idx_0)))" -"(let-values(((result_1)" +" radix_0" +"(let-values(((state88_0) state_0)((c89_0) c_0))" +"(set-exactness-by-char30.1 #f state88_0 c89_0)))" +" (bad-no-digits \".\" s_0 state_0)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" +"(let-values()(bad-mixed-decimal-fraction s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" "(let-values()" -"(let-values(((result_1)" -"(let-values()(let-values()(char=? c_0 '#\\#)))))" -"(values result_1)))))" -"(if(if(not((lambda x_0 result_1) c_0))(not #f) #f)" -"(for-loop_0 result_1(unsafe-fx+ idx_0 1))" -" result_1)))" -" result_0)))))" -" for-loop_0)" -" #f" -" start*_0))))))" -"(define-values" -"(replace-hashes)" -"(lambda(s_0 start_0 end_0)" -"(begin" -"(let-values(((new-s_0)(make-string(fx- end_0 start_0))))" -"(begin" -"(let-values(((v*_0 start*_0 stop*_0 step*_0)" -"(normalise-inputs" -" 'in-string" -" \"string\"" -"(lambda(x_0)(string? x_0))" -"(lambda(x_0)(unsafe-string-length x_0))" -" s_0" -" start_0" -" end_0" -" 1))" -"((start_1) 0))" -"(begin" -" #t" -"(if(variable-reference-from-unsafe?(#%variable-reference))" -"(void)" -"(let-values()(check-naturals start_1)))" -"((letrec-values(((for-loop_0)" -"(lambda(idx_0 pos_0)" -"(begin" -" 'for-loop" -"(if(if(unsafe-fx< idx_0 stop*_0) #t #f)" -"(let-values(((c_0)(string-ref v*_0 idx_0))((i_0) pos_0))" -"(let-values((()" -"(let-values()" -"(let-values((()" -"(let-values()" -"(begin" -"(let-values()" -"(if(char=? c_0 '#\\#)" -"(string-set! new-s_0 i_0 '#\\0)" -"(string-set! new-s_0 i_0 c_0)))" -"(values)))))" -"(values)))))" -"(if(not #f)(for-loop_0(unsafe-fx+ idx_0 1)(+ pos_0 1))(values))))" -"(values))))))" -" for-loop_0)" -" start*_0" -" start_1)))" -"(void)" -" new-s_0)))))" -"(define-values" -"(maybe-substring)" -"(lambda(s_0 start_0 end_0)" -"(begin(if(if(fx= 0 start_0)(fx= end_0(string-length s_0)) #f) s_0(substring s_0 start_0 end_0)))))" -"(define-values" -"(exactness-set?)" -"(lambda(exactness_0)" -"(begin(let-values(((or-part_0)(eq? exactness_0 'exact)))(if or-part_0 or-part_0(eq? exactness_0 'inexact))))))" -"(define-values" -"(char-sign?)" -"(lambda(c_0)(begin(let-values(((or-part_0)(char=? c_0 '#\\-)))(if or-part_0 or-part_0(char=? c_0 '#\\+))))))" -"(define-values" -"(digit?)" -"(lambda(c_0 radix_0)" -"(begin" -"(let-values(((v_0)(char->integer c_0)))" -"(let-values(((or-part_0)(if(fx>= v_0(char->integer '#\\0))(fx<(fx- v_0(char->integer '#\\0)) radix_0) #f)))" +"(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)" +" (bad-misplaced \"#\" s_0 state_0)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" "(if or-part_0" " or-part_0" -"(if(fx> radix_0 10)" -"(let-values(((or-part_1)" -"(if(fx>= v_0(char->integer '#\\a))" -"(fx<(fx- v_0(fx-(char->integer '#\\a) 10)) radix_0)" -" #f)))" +"(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(if n_0" +"(read-imag" +" c_0" +" sgn_0" +"(get-n_0)" +"(if(eqv? c_0 '#\\+) 1 -1)" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +" state_0)" +" (bad-no-digits \".\" s_0 state_0)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_1)(read-polar sgn_0 n_1 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_1)(finish-imaginary sgn_0 n_1 s_0(fx+ 1 start_0) end_0 state_0)) v_0))))" +"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))" +"(define-values" +"(read-approx)" +"(lambda(sgn_0 n_0 exp_0 saw-.?_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(let-values(((get-n_0)(lambda()(begin 'get-n(lazy-number(* sgn_0 n_0) radix_0 exp_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()(finish sgn_0(get-n_0) s_0 state_0))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +" (let-values () (bad-misplaced \"#\" s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(if saw-.?_0" +" (bad-misplaced \".\" s_0 state_0)" +"(read-approx sgn_0 n_0 exp_0 #t 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-approx" +" sgn_0" +" n_0" +"(if saw-.?_0 exp_0(fx+ 1 exp_0))" +" saw-.?_0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +" state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\E)))" "(if or-part_1" " or-part_1" -"(if(fx>= v_0(char->integer '#\\A))(fx<(fx- v_0(fx-(char->integer '#\\A) 10)) radix_0) #f)))" -" #f)))))))" +"(let-values(((or-part_2)(eqv? c_0 '#\\d)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? c_0 '#\\D)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? c_0 '#\\l)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? c_0 '#\\L)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? c_0 '#\\f)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? c_0 '#\\F)))" +"(if or-part_7" +" or-part_7" +"(let-values(((or-part_8)(eqv? c_0 '#\\s)))" +"(if or-part_8" +" or-part_8" +"(let-values(((or-part_9)(eqv? c_0 '#\\S)))" +"(if or-part_9" +" or-part_9" +"(let-values(((or-part_10)(eqv? c_0 '#\\t)))" +"(if or-part_10" +" or-part_10" +"(let-values(((or-part_11)(eqv? c_0 '#\\T)))" +"(if or-part_11 or-part_11 #f))))))))))))))))))))))))" +"(let-values()" +"(read-exponent" +" sgn_0" +"(* sgn_0 n_0)" +" exp_0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state90_0) state_0)((c91_0) c_0))" +"(set-exactness-by-char30.1 #f state90_0 c91_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(if saw-.?_0" +"(bad-mixed-decimal-fraction s_0 state_0)" +"(read-rational sgn_0(get-n_0) #f 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" +"(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(read-imag" +" c_0" +" sgn_0" +"(get-n_0)" +"(if(eqv? c_0 '#\\+) 1 -1)" +" 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-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))" +"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))" "(define-values" -"(fail-bad-number)" -"(lambda(convert-mode_0 s_0 start_0 end_0)" +"(read-exponent)" +"(lambda(sgn_0 sgn-n_0 exp_0 s_0 start_0 end_0 radix_0 state_0)" "(begin" -"(if(eq? convert-mode_0 'must-read)" -" (let-values () (format \"bad number `~.a`\" (substring s_0 start_0 end_0)))" -"(let-values() #f)))))" +"(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(let-values(((or-part_1)(eqv? c_0 '#\\@)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"empty exponent `~.a`\" s_0))" +"(let-values() #f)))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +"(let-values()(read-signed-exponent sgn_0 sgn-n_0 exp_0 1 c_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(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(let-values(((sgn2_0)(if(eqv? c_0 '#\\+) 1 -1)))" +"(read-signed-exponent sgn_0 sgn-n_0 exp_0 sgn2_0 #f 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" +"(let-values(((or-part_1)(eqv? c_0 '#\\#)))" +"(if or-part_1" +" or-part_1" +"(let-values(((or-part_2)(eqv? c_0 '#\\/)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? c_0 '#\\e)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? c_0 '#\\E)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? c_0 '#\\d)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? c_0 '#\\D)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? c_0 '#\\l)))" +"(if or-part_7" +" or-part_7" +"(let-values(((or-part_8)(eqv? c_0 '#\\L)))" +"(if or-part_8" +" or-part_8" +"(let-values(((or-part_9)(eqv? c_0 '#\\f)))" +"(if or-part_9" +" or-part_9" +"(let-values(((or-part_10)(eqv? c_0 '#\\F)))" +"(if or-part_10" +" or-part_10" +"(let-values(((or-part_11)(eqv? c_0 '#\\s)))" +"(if or-part_11" +" or-part_11" +"(let-values(((or-part_12)(eqv? c_0 '#\\S)))" +"(if or-part_12" +" or-part_12" +"(let-values(((or-part_13)(eqv? c_0 '#\\t)))" +"(if or-part_13" +" or-part_13" +"(let-values(((or-part_14)(eqv? c_0 '#\\T)))" +"(if or-part_14" +" or-part_14" +" #f))))))))))))))))))))))))))))))" +"(let-values()(bad-misplaced c_0 s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(if(state-has-first-half? state_0)" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"empty exponent `~.a`\" s_0))" +"(let-values() #f))" +" (bad-misplaced \"i\" s_0 state_0)))" +"(let-values()(bad-digit c_0 s_0 state_0)))))))))))" "(define-values" -"(read-complains)" -"(lambda(convert-mode_0)(begin(if(eq? convert-mode_0 'read) 'must-read convert-mode_0))))" +"(read-signed-exponent)" +"(lambda(sgn_0 sgn-n_0 exp_0 sgn2_0 exp2_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(let-values(((get-n_0)" +"(lambda()" +"(begin" +" 'get-n" +"(if exp2_0" +"(lazy-number sgn-n_0 radix_0(+ exp_0(* sgn2_0 exp2_0)))" +"(if(eq?(state->convert-mode state_0) 'must-read)" +" (let-values () (format \"empty exponent `~.a`\" s_0))" +"(let-values() #f)))))))" +"(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 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)" +" #f)" +" #f)))" +"(if or-part_0" +" or-part_0" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_1)(not v_0)))(if or-part_1 or-part_1(string? v_0)))" +" v_0" +"((lambda(n_0)(finish sgn_0 n_0 s_0 state_0)) 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)))" +"(read-signed-exponent" +" sgn_0" +" sgn-n_0" +" exp_0" +" sgn2_0" +" new-exp2_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(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)" +"(read-imag c_0 sgn_0 n_0(if(eqv? c_0 '#\\+) 1 -1) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" +" v_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\#)))" +"(if or-part_1" +" or-part_1" +"(let-values(((or-part_2)(eqv? c_0 '#\\/)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? c_0 '#\\e)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? c_0 '#\\E)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? c_0 '#\\d)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? c_0 '#\\D)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? c_0 '#\\l)))" +"(if or-part_7" +" or-part_7" +"(let-values(((or-part_8)(eqv? c_0 '#\\L)))" +"(if or-part_8" +" or-part_8" +"(let-values(((or-part_9)(eqv? c_0 '#\\f)))" +"(if or-part_9" +" or-part_9" +"(let-values(((or-part_10)(eqv? c_0 '#\\F)))" +"(if or-part_10" +" or-part_10" +"(let-values(((or-part_11)(eqv? c_0 '#\\s)))" +"(if or-part_11" +" or-part_11" +"(let-values(((or-part_12)(eqv? c_0 '#\\S)))" +"(if or-part_12" +" or-part_12" +"(let-values(((or-part_13)(eqv? c_0 '#\\t)))" +"(if or-part_13" +" or-part_13" +"(let-values(((or-part_14)(eqv? c_0 '#\\T)))" +"(if or-part_14" +" or-part_14" +" #f))))))))))))))))))))))))))))))" +"(let-values()(bad-misplaced c_0 s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)(finish-imaginary sgn_0 n_0 s_0(fx+ 1 start_0) end_0 state_0)) v_0))))" +"(let-values()(bad-digit c_0 s_0 state_0)))))))))))))" +"(define-values" +"(read-infinity)" +"(lambda(sgn_0 c_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(let-values(((fail_0)(lambda()(begin 'fail(bad-digit c_0 s_0 state_0)))))" +"(let-values(((start+n_0)(fx+ start_0 0)))" +"(let-values(((var_0)(if(fx= start+n_0 end_0) 'eof(string-ref s_0 start+n_0))))" +"(let-values(((tmp_0) var_0))" +"(if(if(equal? tmp_0 '#\\f) #t(equal? tmp_0 '#\\F))" +"(let-values()" +"(let-values(((fail_1)(lambda()(begin 'fail(fail_0)))))" +"(let-values(((start+n_1)(fx+ start_0(+ 0 1))))" +"(let-values(((var_1)(if(fx= start+n_1 end_0) 'eof(string-ref s_0 start+n_1))))" +"(let-values(((tmp_1) var_1))" +"(if(equal? tmp_1 '#\\.)" +"(let-values()" +"(let-values(((fail_2)(lambda()(begin 'fail(fail_1)))))" +"(let-values(((start+n_2)(fx+ start_0(+(+ 0 1) 1))))" +"(let-values(((var_2)(if(fx= start+n_2 end_0) 'eof(string-ref s_0 start+n_2))))" +"(let-values(((tmp_2) var_2))" +"(if(if(equal? tmp_2 '#\\0) #t(if(equal? tmp_2 '#\\f) #t(equal? tmp_2 '#\\t)))" +"(let-values()" +"(let-values()" +"(let-values(((n_0)(if(negative? sgn_0) -inf.0 +inf.0)))" +"(let-values(((new-state_0)" +"(let-values(((state92_0) state_0)" +"((temp93_0)(string-ref s_0(fx+ start_0 2)))" +"((temp94_0) #t))" +"(set-exactness-by-char30.1 temp94_0 state92_0 temp93_0))))" +"(let-values(((c2_0)" +"(if(fx=(fx+ 3 start_0) end_0)" +" 'eof" +"(let-values(((c_1)(string-ref s_0(fx+ 3 start_0))))" +"(maybe-digit c_1 radix_0)))))" +"(if(let-values(((or-part_0)(eqv? c2_0 'eof)))" +"(if or-part_0 or-part_0 #f))" +"(let-values()(finish sgn_0 n_0 s_0 new-state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\+)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c2_0 '#\\-)))" +"(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(read-imag" +" c2_0" +" sgn_0" +" n_0" +"(if(eqv? c2_0 '#\\+) 1 -1)" +" s_0" +"(fx+ 4 start_0)" +" end_0" +" radix_0" +" new-state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\@)))" +"(if or-part_0 or-part_0 #f))" +"(let-values()" +"(read-polar" +" sgn_0" +" n_0" +" s_0" +"(fx+ 4 start_0)" +" end_0" +" radix_0" +" new-state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))" +"(if or-part_0 or-part_0 #f))" +"(let-values()" +"(finish-imaginary" +" sgn_0" +" n_0" +" s_0" +"(fx+ 4 start_0)" +" end_0" +" new-state_0))" +"(let-values()(bad-digit c_0 s_0 state_0)))))))))))" +"(let-values()(fail_2))))))))" +"(let-values()(fail_1))))))))" +"(let-values()(fail_0))))))))))" +"(define-values" +"(read-nan)" +"(lambda(c_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(let-values(((fail_0)(lambda()(begin 'fail(bad-digit c_0 s_0 state_0)))))" +"(let-values(((start+n_0)(fx+ start_0 0)))" +"(let-values(((var_0)(if(fx= start+n_0 end_0) 'eof(string-ref s_0 start+n_0))))" +"(let-values(((tmp_0) var_0))" +"(if(if(equal? tmp_0 '#\\a) #t(equal? tmp_0 '#\\A))" +"(let-values()" +"(let-values(((fail_1)(lambda()(begin 'fail(fail_0)))))" +"(let-values(((start+n_1)(fx+ start_0(+ 0 1))))" +"(let-values(((var_1)(if(fx= start+n_1 end_0) 'eof(string-ref s_0 start+n_1))))" +"(let-values(((tmp_1) var_1))" +"(if(if(equal? tmp_1 '#\\n) #t(equal? tmp_1 '#\\N))" +"(let-values()" +"(let-values(((fail_2)(lambda()(begin 'fail(fail_1)))))" +"(let-values(((start+n_2)(fx+ start_0(+(+ 0 1) 1))))" +"(let-values(((var_2)(if(fx= start+n_2 end_0) 'eof(string-ref s_0 start+n_2))))" +"(let-values(((tmp_2) var_2))" +"(if(equal? tmp_2 '#\\.)" +"(let-values()" +"(let-values(((fail_3)(lambda()(begin 'fail(fail_2)))))" +"(let-values(((start+n_3)(fx+ start_0(+(+(+ 0 1) 1) 1))))" +"(let-values(((var_3)" +"(if(fx= start+n_3 end_0) 'eof(string-ref s_0 start+n_3))))" +"(let-values(((tmp_3) var_3))" +"(if(if(equal? tmp_3 '#\\0)" +" #t" +"(if(equal? tmp_3 '#\\f) #t(equal? tmp_3 '#\\t)))" +"(let-values()" +"(let-values()" +"(let-values(((n_0) +nan.0))" +"(let-values(((new-state_0)" +"(let-values(((state95_0) state_0)" +"((temp96_0)" +"(string-ref s_0(fx+ start_0 3)))" +"((temp97_0) #t))" +"(set-exactness-by-char30.1" +" temp97_0" +" state95_0" +" temp96_0))))" +"(let-values(((c2_0)" +"(if(fx=(fx+ 4 start_0) end_0)" +" 'eof" +"(let-values(((c_1)" +"(string-ref" +" s_0" +"(fx+ 4 start_0))))" +"(maybe-digit c_1 radix_0)))))" +"(if(let-values(((or-part_0)(eqv? c2_0 'eof)))" +"(if or-part_0 or-part_0 #f))" +"(let-values()(finish 1 n_0 s_0 new-state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\+)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c2_0 '#\\-)))" +"(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(read-imag" +" c2_0" +" 1" +" n_0" +"(if(eqv? c2_0 '#\\+) 1 -1)" +" s_0" +"(fx+ 5 start_0)" +" end_0" +" radix_0" +" new-state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\@)))" +"(if or-part_0 or-part_0 #f))" +"(let-values()" +"(read-polar" +" 1" +" n_0" +" s_0" +"(fx+ 5 start_0)" +" end_0" +" radix_0" +" new-state_0))" +"(if(let-values(((or-part_0)(eqv? c2_0 '#\\i)))" +"(if or-part_0 or-part_0 #f))" +"(let-values()" +"(finish-imaginary" +" 1" +" n_0" +" s_0" +"(fx+ 5 start_0)" +" end_0" +" new-state_0))" +"(let-values()" +"(bad-digit c_0 s_0 state_0)))))))))))" +"(let-values()(fail_3))))))))" +"(let-values()(fail_2))))))))" +"(let-values()(fail_1))))))))" +"(let-values()(fail_0))))))))))" +"(define-values" +"(read-rational)" +"(lambda(sgn_0 sgn-n_0 d_0 s_0 start_0 end_0 radix_0 state_0)" +"(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))))))" +"(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(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)(finish sgn_0 n_0 s_0 state_0)) v_0))))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(read-rational" +" sgn_0" +" sgn-n_0" +"(+(if d_0(* d_0 radix_0) 0) c_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()(bad-mixed-decimal-fraction s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(if d_0" +"(read-denom-approx" +" sgn_0" +" sgn-n_0" +" d_0" +" 1" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state98_0) state_0)((temp99_0) 'approx))" +"(set-exactness23.1 #f state98_0 temp99_0)))" +" (bad-misplaced \"#\" s_0 state_0)))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\E)))" +"(if or-part_1" +" or-part_1" +"(let-values(((or-part_2)(eqv? c_0 '#\\d)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? c_0 '#\\D)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? c_0 '#\\l)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? c_0 '#\\L)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? c_0 '#\\f)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? c_0 '#\\F)))" +"(if or-part_7" +" or-part_7" +"(let-values(((or-part_8)(eqv? c_0 '#\\s)))" +"(if or-part_8" +" or-part_8" +"(let-values(((or-part_9)(eqv? c_0 '#\\S)))" +"(if or-part_9" +" or-part_9" +"(let-values(((or-part_10)(eqv? c_0 '#\\t)))" +"(if or-part_10" +" or-part_10" +"(let-values(((or-part_11)(eqv? c_0 '#\\T)))" +"(if or-part_11 or-part_11 #f))))))))))))))))))))))))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(sgn-n_1)" +"(read-exponent" +" sgn_0" +" sgn-n_1" +" 0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state100_0) state_0)((c101_0) c_0))" +"(set-exactness-by-char30.1 #f state100_0 c101_0))))" +" v_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\/)))(if or-part_0 or-part_0 #f))" +" (let-values () (bad-misplaced \"/\" s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)" +"(read-imag" +" c_0" +" sgn_0" +" n_0" +"(if(eqv? c_0 '#\\+) 1 -1)" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +" state_0))" +" v_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\@)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)(read-polar sgn_0 n_0 s_0(fx+ 1 start_0) end_0 radix_0 state_0)) v_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((v_0)(get-n_0)))" +"(if(let-values(((or-part_0)(not v_0)))(if or-part_0 or-part_0(string? v_0)))" +" v_0" +"((lambda(n_0)(finish-imaginary sgn_0 n_0 s_0(fx+ 1 start_0) end_0 state_0)) v_0))))" +"(let-values()(bad-digit c_0 s_0 state_0))))))))))))))))" +"(define-values" +"(read-denom-approx)" +"(lambda(sgn_0 sgn-n_0 d_0 exp_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(let-values(((get-n_0)(lambda()(begin 'get-n(lazy-divide sgn-n_0(lazy-number d_0 radix_0 exp_0) 'approx)))))" +"(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()(finish sgn_0(get-n_0) s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\#)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(read-denom-approx sgn_0 sgn-n_0 d_0(fx+ 1 exp_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +" (let-values () (bad-misplaced \"#\" s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\.)))" +"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\/)))(if or-part_1 or-part_1 #f))))" +"(let-values()(bad-misplaced c_0 s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\e)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\E)))" +"(if or-part_1" +" or-part_1" +"(let-values(((or-part_2)(eqv? c_0 '#\\d)))" +"(if or-part_2" +" or-part_2" +"(let-values(((or-part_3)(eqv? c_0 '#\\D)))" +"(if or-part_3" +" or-part_3" +"(let-values(((or-part_4)(eqv? c_0 '#\\l)))" +"(if or-part_4" +" or-part_4" +"(let-values(((or-part_5)(eqv? c_0 '#\\L)))" +"(if or-part_5" +" or-part_5" +"(let-values(((or-part_6)(eqv? c_0 '#\\f)))" +"(if or-part_6" +" or-part_6" +"(let-values(((or-part_7)(eqv? c_0 '#\\F)))" +"(if or-part_7" +" or-part_7" +"(let-values(((or-part_8)(eqv? c_0 '#\\s)))" +"(if or-part_8" +" or-part_8" +"(let-values(((or-part_9)(eqv? c_0 '#\\S)))" +"(if or-part_9" +" or-part_9" +"(let-values(((or-part_10)(eqv? c_0 '#\\t)))" +"(if or-part_10" +" or-part_10" +"(let-values(((or-part_11)(eqv? c_0 '#\\T)))" +"(if or-part_11 or-part_11 #f))))))))))))))))))))))))" +"(let-values()" +"(read-exponent" +" sgn_0" +"(get-n_0)" +" 0" +" s_0" +"(fx+ 1 start_0)" +" end_0" +" radix_0" +"(let-values(((state102_0) state_0)((c103_0) c_0))" +"(set-exactness-by-char30.1 #f state102_0 c103_0))))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" +"(if or-part_0" +" or-part_0" +"(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(read-imag" +" c_0" +" sgn_0" +"(get-n_0)" +"(if(eqv? c_0 '#\\+) 1 -1)" +" 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-polar sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 radix_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\i)))(if or-part_0 or-part_0 #f))" +"(let-values()(finish-imaginary sgn_0(get-n_0) s_0(fx+ 1 start_0) end_0 state_0))" +"(let-values()(bad-digit c_0 s_0 state_0)))))))))))))))" +"(define-values" +"(read-imag)" +"(lambda(c_0 real-sgn_0 real_0 sgn_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(if(let-values(((or-part_0)(state-has-first-half? state_0)))" +"(if or-part_0 or-part_0(eq? 'extended(parse-state-exactness state_0))))" +"(let-values()(bad-misplaced c_0 s_0 state_0))" +"(let-values()" +"(read-signed" +" sgn_0" +" s_0" +" start_0" +" end_0" +" radix_0" +"(state-set-first-half state_0(rect-prefix8.1 real-sgn_0 real_0))))))))" +"(define-values" +"(read-polar)" +"(lambda(real-sgn_0 real_0 s_0 start_0 end_0 radix_0 state_0)" +"(begin" +"(if(let-values(((or-part_0)(state-has-first-half? state_0)))" +"(if or-part_0 or-part_0(eq? 'extended(parse-state-exactness state_0))))" +" (let-values () (bad-misplaced \"@\" s_0 state_0))" +"(let-values()" +"(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 () (bad-misplaced \"@\" s_0 state_0))" +"(if(let-values(((or-part_0)(eqv? c_0 '#\\+)))" +"(if or-part_0 or-part_0(let-values(((or-part_1)(eqv? c_0 '#\\-)))(if or-part_1 or-part_1 #f))))" +"(let-values()" +"(let-values(((new-state_0)(state-set-first-half state_0(polar-prefix9.1 real-sgn_0 real_0))))" +"(read-signed(if(eq? c_0 '#\\+) 1 -1) s_0(fx+ 1 start_0) end_0 radix_0 new-state_0)))" +"(if(let-values(((or-part_0)(fixnum? c_0)))(if or-part_0 or-part_0 #f))" +"(let-values()" +"(let-values(((new-state_0)(state-set-first-half state_0(polar-prefix9.1 real-sgn_0 real_0))))" +"(read-integer 1 c_0 s_0(fx+ 1 start_0) end_0 radix_0 new-state_0)))" +"(let-values()(bad-digit c_0 s_0 state_0)))))))))))" "(define-values" "(read-symbol-or-number8.1)" "(lambda(extra-prefix2_0 mode1_0 init-c5_0 in6_0 orig-config7_0)"