io, read: use fixnum operators
This commit is contained in:
Matthew Flatt
parent
d0eb8f6c53
commit
aa75a2fd32
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
(require "config.rkt")
|
||||
(require racket/fixnum
|
||||
"config.rkt")
|
||||
|
||||
;; An `accum-string` is a buffer for accumulating characters.
|
||||
;; We cache the buffer in the config record so that it can
|
||||
|
|
@ -33,15 +34,15 @@
|
|||
(define str (accum-string-str a))
|
||||
(define str2
|
||||
(cond
|
||||
[(pos . < . (string-length str))
|
||||
[(pos . fx< . (string-length str))
|
||||
str]
|
||||
[else
|
||||
(define str2 (make-string (* (string-length str) 2)))
|
||||
(define str2 (make-string (fx* (string-length str) 2)))
|
||||
(string-copy! str2 0 str)
|
||||
(set-accum-string-str! a str2)
|
||||
str2]))
|
||||
(string-set! str2 pos c)
|
||||
(set-accum-string-pos! a (add1 pos)))
|
||||
(set-accum-string-pos! a (fx+ 1 pos)))
|
||||
|
||||
(define (accum-string-count a)
|
||||
(accum-string-pos a))
|
||||
|
|
@ -58,12 +59,12 @@
|
|||
start-pos
|
||||
(accum-string-pos a))))
|
||||
(define len (string-length s))
|
||||
(unless ((+ len start-pos) . < . (string-length str))
|
||||
(define str2 (make-string (+ start-pos len)))
|
||||
(unless ((fx+ len start-pos) . fx< . (string-length str))
|
||||
(define str2 (make-string (fx+ start-pos len)))
|
||||
(string-copy! str2 0 str 0 start-pos)
|
||||
(set-accum-string-str! a str2))
|
||||
(string-copy! (accum-string-str a) start-pos s)
|
||||
(set-accum-string-pos! a (+ start-pos len)))
|
||||
(set-accum-string-pos! a (fx+ start-pos len)))
|
||||
|
||||
(define (accum-string-get! a config #:start-pos [start-pos 0])
|
||||
(define s (substring (accum-string-str a)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
(require racket/private/check
|
||||
racket/fixnum
|
||||
racket/extflonum
|
||||
;; Call the host `string->number` function only
|
||||
;; on valid fixnum, bignum, {single-,double-,ext}flonum
|
||||
|
|
@ -66,16 +67,16 @@
|
|||
#:in-complex [in-complex #f] ; #f, 'i, or '@
|
||||
convert-mode)
|
||||
(cond
|
||||
[(= start end)
|
||||
[(fx= start end)
|
||||
(fail convert-mode "no digits")]
|
||||
[else
|
||||
(define c (string-ref s start))
|
||||
(cond
|
||||
;; `#e`, `#x`, etc.
|
||||
[(char=? #\# c)
|
||||
(define next (add1 start))
|
||||
(define next (fx+ 1 start))
|
||||
(cond
|
||||
[(= next end)
|
||||
[(fx= next end)
|
||||
(fail convert-mode "no character after `#` indicator in `~.a`" s)]
|
||||
[else
|
||||
(define i (string-ref s next))
|
||||
|
|
@ -85,7 +86,7 @@
|
|||
[(or (exactness-set? exactness) in-complex)
|
||||
(fail convert-mode "misplaced exactness specification at `~.a`" (substring s start end))]
|
||||
[else
|
||||
(do-string->number s (add1 next) end
|
||||
(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))])]
|
||||
|
|
@ -100,7 +101,7 @@
|
|||
[(#\o #\O) 8]
|
||||
[(#\d #\D) 10]
|
||||
[else 16]))
|
||||
(do-string->number s (add1 next) end
|
||||
(do-string->number s (fx+ 1 next) end
|
||||
radix #:radix-set? #t
|
||||
exactness
|
||||
(if (eq? convert-mode 'read) 'must-read convert-mode))])]
|
||||
|
|
@ -119,13 +120,13 @@
|
|||
;; +inf.0+...i, etc.
|
||||
[(and (char-sign? c)
|
||||
(not in-complex)
|
||||
((- end start) . > . 7)
|
||||
(char=? #\i (string-ref s (sub1 end)))
|
||||
((fx- end start) . fx> . 7)
|
||||
(char=? #\i (string-ref s (fx- end 1)))
|
||||
(char-sign? (string-ref s 6))
|
||||
(read-special-number s start (+ start 6) convert-mode))
|
||||
(read-special-number s start (fx+ start 6) convert-mode))
|
||||
=>
|
||||
(lambda (v)
|
||||
(read-for-special-compound s (+ start 6) (sub1 end)
|
||||
(read-for-special-compound s (fx+ start 6) (fx- end 1)
|
||||
radix
|
||||
exactness
|
||||
convert-mode
|
||||
|
|
@ -134,18 +135,18 @@
|
|||
(make-rectangular v v2))))]
|
||||
;; ...+inf.0i, etc.
|
||||
[(and (not in-complex)
|
||||
((- end start) . >= . 7) ; allow `+inf.0i`
|
||||
(char=? #\i (string-ref s (sub1 end)))
|
||||
(char-sign? (string-ref s (- end 7)))
|
||||
(read-special-number s (- end 7) (sub1 end) convert-mode))
|
||||
((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 (= start (- end 7))
|
||||
[(and (fx= start (fx- end 7))
|
||||
(not (extflonum? v2)))
|
||||
(make-rectangular 0 v2)]
|
||||
[else
|
||||
(read-for-special-compound s start (- end 7)
|
||||
(read-for-special-compound s start (fx- end 7)
|
||||
radix
|
||||
exactness
|
||||
convert-mode
|
||||
|
|
@ -156,12 +157,12 @@
|
|||
;; +inf.0@..., etc.
|
||||
[(and (char-sign? c)
|
||||
(not in-complex)
|
||||
((- end start) . > . 7)
|
||||
(char=? #\@ (string-ref s (+ start 6)))
|
||||
(read-special-number s start (+ start 6) convert-mode))
|
||||
((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 (+ start 7) end
|
||||
(read-for-special-compound s (fx+ start 7) end
|
||||
radix
|
||||
exactness
|
||||
convert-mode
|
||||
|
|
@ -170,12 +171,12 @@
|
|||
(make-polar v v2))))]
|
||||
;; ...@+inf.0, etc.
|
||||
[(and (not in-complex)
|
||||
((- end start) . > . 7)
|
||||
(char=? #\@ (string-ref s (- end 7)))
|
||||
(read-special-number s (- end 6) end convert-mode))
|
||||
((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 (- end 7)
|
||||
(read-for-special-compound s start (fx- end 7)
|
||||
radix
|
||||
exactness
|
||||
convert-mode
|
||||
|
|
@ -207,7 +208,7 @@
|
|||
[sign-pos #f] [dot-pos #f] [slash-pos #f] [exp-pos #f]
|
||||
[must-i? #f])
|
||||
(cond
|
||||
[(= i end)
|
||||
[(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.
|
||||
|
|
@ -223,18 +224,18 @@
|
|||
[(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 . < . sign-pos))
|
||||
(and slash-pos (slash-pos . < . 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 (sub1 end)
|
||||
(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 (add1 @-pos) end
|
||||
(string->complex-number s start @-pos (fx+ 1 @-pos) end
|
||||
i-pos sign-pos
|
||||
radix #:radix-set? radix-set?
|
||||
exactness
|
||||
|
|
@ -251,11 +252,11 @@
|
|||
(define c (string-ref s i))
|
||||
(cond
|
||||
[(digit? c radix)
|
||||
(loop (add1 i) #t any-hashes? i-pos @-pos
|
||||
(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 (add1 i) #t #t i-pos @-pos
|
||||
(loop (fx+ 1 i) #t #t i-pos @-pos
|
||||
sign-pos dot-pos slash-pos exp-pos
|
||||
must-i?)]
|
||||
[(char-sign? c)
|
||||
|
|
@ -263,30 +264,30 @@
|
|||
[(and sign-pos must-i?)
|
||||
(fail convert-mode "too many signs in `~.a`" (substring s start end))]
|
||||
[else
|
||||
(loop (add1 i) any-digits? any-hashes? i-pos @-pos
|
||||
(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 (> i start) (or (not @-pos) (> i (add1 @-pos)))))])]
|
||||
(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 . > . sign-pos)))
|
||||
(and dot-pos (or (not sign-pos) (dot-pos . > . sign-pos))))
|
||||
[(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 . > . sign-pos)))
|
||||
[(and slash-pos (or (not sign-pos) (slash-pos . fx> . sign-pos)))
|
||||
(fail convert-mode "decimal points and fractions annot be mixed `~.a`" (substring s start end))]
|
||||
[else
|
||||
(loop (add1 i) any-digits? any-hashes? i-pos @-pos
|
||||
(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 . > . sign-pos)))
|
||||
[(and dot-pos (or (not sign-pos) (dot-pos . fx> . sign-pos)))
|
||||
(fail convert-mode "decimal points and fractions annot be mixed `~.a`" (substring s start end))]
|
||||
[(or (and exp-pos (or (not sign-pos) (exp-pos . > . sign-pos)))
|
||||
(and slash-pos (or (not sign-pos) (slash-pos . > . sign-pos))))
|
||||
[(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 (add1 i) any-digits? any-hashes? i-pos @-pos
|
||||
(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)
|
||||
|
|
@ -299,13 +300,13 @@
|
|||
[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 ((add1 i) . < . end)
|
||||
(char-sign? (string-ref s (add1 i))))
|
||||
(loop (+ i 2) any-digits? any-hashes? i-pos @-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 (+ i 1) any-digits? any-hashes? i-pos @-pos
|
||||
(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 #\@)
|
||||
|
|
@ -314,12 +315,12 @@
|
|||
(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))]
|
||||
[(= i start)
|
||||
[(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 (add1 i) any-digits? any-hashes? i-pos i
|
||||
(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))
|
||||
|
|
@ -327,10 +328,10 @@
|
|||
(cond
|
||||
[(or @-pos (eq? in-complex '@))
|
||||
(fail convert-mode "cannot mix `@` and `i` in `~.a`" (substring s start end))]
|
||||
[(or ((add1 i) . < . end) (eq? in-complex 'i))
|
||||
[(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 (add1 i) any-digits? any-hashes? i @-pos
|
||||
(loop (fx+ 1 i) any-digits? any-hashes? i @-pos
|
||||
sign-pos #f #f #f
|
||||
#f)])]
|
||||
[else
|
||||
|
|
@ -350,7 +351,7 @@
|
|||
#:in-complex in-complex ; 'i or '@
|
||||
convert-mode)
|
||||
(define v1 (cond
|
||||
[(= start1 end1)
|
||||
[(fx= start1 end1)
|
||||
;; The input was "[+-]<num>i", so the real part
|
||||
;; is implicitly "0"
|
||||
(if (eq? exactness 'inexact)
|
||||
|
|
@ -364,7 +365,7 @@
|
|||
convert-mode)]))
|
||||
(define v2 (cond
|
||||
[(and (eq? in-complex 'i)
|
||||
(= (- end2 start2) 1))
|
||||
(fx= (fx- end2 start2) 1))
|
||||
;; The input ends "[+-]i", so the number is implicitly
|
||||
;; "1"
|
||||
(define neg? (char=? (string-ref s start2) #\-))
|
||||
|
|
@ -420,22 +421,22 @@
|
|||
(not (eq? convert-mode 'number-or-false))
|
||||
(not (extfl-mark?)))
|
||||
(not (and any-hashes? (hashes? s start end)))))
|
||||
(define has-sign? (and (end . > . start) (char-sign? (string-ref s start))))
|
||||
(define has-sign? (and (end . fx> . start) (char-sign? (string-ref s start))))
|
||||
(cond
|
||||
[(= (- end start) (+ (if dot-pos 1 0) (if exp-pos 1 0) (if has-sign? 1 0)))
|
||||
(if (= end start)
|
||||
[(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 (= (- exp-pos start)
|
||||
(+ (if (and dot-pos (< dot-pos exp-pos)) 1 0)
|
||||
(if has-sign? 1 0))))
|
||||
[(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 (= exp-pos (sub1 end))
|
||||
(and (= exp-pos (- end 2))
|
||||
(char-sign? (string-ref s (sub1 end))))))
|
||||
(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
|
||||
|
|
@ -465,7 +466,7 @@
|
|||
radix
|
||||
'exact
|
||||
convert-mode))
|
||||
(define e-v (string->exact-integer-number s (+ exp-pos 1) end
|
||||
(define e-v (string->exact-integer-number s (fx+ exp-pos 1) end
|
||||
radix
|
||||
convert-mode))
|
||||
(define (real->precision-inexact r)
|
||||
|
|
@ -524,7 +525,7 @@
|
|||
radix
|
||||
'exact
|
||||
convert-mode))
|
||||
(define d-v (string->real-number s (add1 slash-pos) end
|
||||
(define d-v (string->real-number s (fx+ 1 slash-pos) end
|
||||
#f #f #f
|
||||
any-hashes?
|
||||
radix
|
||||
|
|
@ -542,7 +543,7 @@
|
|||
[(string? d-v) d-v]
|
||||
[(eqv? d-v 0)
|
||||
(cond
|
||||
[(get-inexact? (add1 slash-pos))
|
||||
[(get-inexact? (fx+ 1 slash-pos))
|
||||
(if (negative? n-v)
|
||||
-inf.0
|
||||
+inf.0)]
|
||||
|
|
@ -571,13 +572,13 @@
|
|||
exactness
|
||||
convert-mode)
|
||||
(define get-exact? (or (eq? exactness 'exact) (eq? exactness 'decimal-as-exact)))
|
||||
(define new-str (make-string (- end start (if (and dot-pos get-exact?) 1 0))))
|
||||
(let loop ([i (sub1 end)] [j (sub1 (string-length new-str))] [hashes-pos end])
|
||||
(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 . < . start)
|
||||
[(i . fx< . start)
|
||||
;; Convert `new-str` to an integer and finish up
|
||||
(cond
|
||||
[(= hashes-pos start)
|
||||
[(fx= hashes-pos start)
|
||||
(fail convert-mode "misplaced `#` in `~.a`" (substring s start end))]
|
||||
[else
|
||||
(define n (host:string->number new-str radix))
|
||||
|
|
@ -590,7 +591,7 @@
|
|||
-0.0
|
||||
(exact->inexact n))]
|
||||
[(and dot-pos get-exact?)
|
||||
(/ n (expt 10 (- end dot-pos 1)))]
|
||||
(/ n (expt 10 (fx- end dot-pos 1)))]
|
||||
[else n])])]
|
||||
[else
|
||||
(define c (string-ref s i))
|
||||
|
|
@ -598,23 +599,23 @@
|
|||
[(char=? c #\.)
|
||||
(cond
|
||||
[get-exact?
|
||||
(loop (sub1 i) j (if (= hashes-pos (add1 i)) i hashes-pos))]
|
||||
(loop (fx- i 1) j (if (fx= hashes-pos (fx+ 1 i)) i hashes-pos))]
|
||||
[else
|
||||
(string-set! new-str j c)
|
||||
(loop (sub1 i) (sub1 j) (if (= hashes-pos (add1 i)) i hashes-pos))])]
|
||||
(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 (sub1 i) (sub1 j) (if (= hashes-pos (add1 i)) i hashes-pos))]
|
||||
(loop (fx- i 1) (fx- j 1) (if (fx= hashes-pos (fx+ 1 i)) i hashes-pos))]
|
||||
[(char=? c #\#)
|
||||
(cond
|
||||
[(= hashes-pos (add1 i))
|
||||
[(fx= hashes-pos (fx+ 1 i))
|
||||
(string-set! new-str j #\0)
|
||||
(loop (sub1 i) (sub1 j) i)]
|
||||
(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 (sub1 i) (sub1 j) hashes-pos)])])))
|
||||
(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
|
||||
|
|
@ -634,40 +635,40 @@
|
|||
;; Try to read as `+inf.0`, etc.
|
||||
(define (read-special-number s start end convert-mode)
|
||||
(and
|
||||
(= (- end start) 6)
|
||||
(fx= (fx- end start) 6)
|
||||
(or (char=? (string-ref s start) #\+)
|
||||
(char=? (string-ref s start) #\-))
|
||||
(or
|
||||
(and (char=? (char-downcase (string-ref s (+ start 1))) #\i)
|
||||
(char=? (char-downcase (string-ref s (+ start 2))) #\n)
|
||||
(char=? (char-downcase (string-ref s (+ start 3))) #\f)
|
||||
(char=? (char-downcase (string-ref s (+ start 4))) #\.)
|
||||
(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 (+ start 5))) #\0)
|
||||
(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 (+ start 5))) #\f)
|
||||
(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 (+ start 5))) #\t)
|
||||
(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 (+ start 1))) #\n)
|
||||
(char=? (char-downcase (string-ref s (+ start 2))) #\a)
|
||||
(char=? (char-downcase (string-ref s (+ start 3))) #\n)
|
||||
(char=? (char-downcase (string-ref s (+ start 4))) #\.)
|
||||
(or (and (char=? (char-downcase (string-ref s (+ start 5))) #\0)
|
||||
(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 (+ start 5))) #\f)
|
||||
(and (char=? (char-downcase (string-ref s (fx+ start 5))) #\f)
|
||||
+nan.f)
|
||||
(and (char=? (char-downcase (string-ref s (+ start 5))) #\t)
|
||||
(and (char=? (char-downcase (string-ref s (fx+ start 5))) #\t)
|
||||
(not (eq? convert-mode 'number-or-false))
|
||||
+nan.t))))))
|
||||
|
||||
|
|
@ -709,7 +710,7 @@
|
|||
(char=? c #\#)))
|
||||
|
||||
(define (replace-hashes s start end)
|
||||
(define new-s (make-string (- end start)))
|
||||
(define new-s (make-string (fx- end start)))
|
||||
(for ([c (in-string s start end)]
|
||||
[i (in-naturals)])
|
||||
(if (char=? c #\#)
|
||||
|
|
@ -718,8 +719,8 @@
|
|||
new-s)
|
||||
|
||||
(define (maybe-substring s start end)
|
||||
(if (and (= 0 start)
|
||||
(= end (string-length s)))
|
||||
(if (and (fx= 0 start)
|
||||
(fx= end (string-length s)))
|
||||
s
|
||||
(substring s start end)))
|
||||
|
||||
|
|
@ -731,15 +732,15 @@
|
|||
|
||||
(define (digit? c radix)
|
||||
(define v (char->integer c))
|
||||
(or (and (v . >= . (char->integer #\0))
|
||||
((- v (char->integer #\0)) . < . radix))
|
||||
(and (radix . > . 10)
|
||||
(or (and (v . fx>= . (char->integer #\0))
|
||||
((fx- v (char->integer #\0)) . fx< . radix))
|
||||
(and (radix . fx> . 10)
|
||||
(or (and
|
||||
(v . >= . (char->integer #\a))
|
||||
((- v (- (char->integer #\a) 10)) . < . radix))
|
||||
(v . fx>= . (char->integer #\a))
|
||||
((fx- v (fx- (char->integer #\a) 10)) . fx< . radix))
|
||||
(and
|
||||
(v . >= . (char->integer #\A))
|
||||
((- v (- (char->integer #\A) 10)) . < . radix))))))
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
(require "../common/check.rkt"
|
||||
(require racket/fixnum
|
||||
"../common/check.rkt"
|
||||
"../common/fixnum.rkt"
|
||||
"../host/thread.rkt"
|
||||
"port.rkt"
|
||||
|
|
@ -58,10 +59,10 @@
|
|||
(define output-closed? #f)
|
||||
|
||||
(define (content-length)
|
||||
(if (start . <= . end)
|
||||
(- end start)
|
||||
(+ end (- len start))))
|
||||
(define (input-empty?) (= start end))
|
||||
(if (start . fx<= . end)
|
||||
(fx- end start)
|
||||
(fx+ end (fx- len start))))
|
||||
(define (input-empty?) (fx= start end))
|
||||
(define (output-full?)
|
||||
(and limit
|
||||
((content-length) . >= . (+ limit peeked-amt))))
|
||||
|
|
@ -76,7 +77,7 @@
|
|||
[() (or write-pos end)]
|
||||
[(pos)
|
||||
;; `pos` must be between `start` and `end`
|
||||
(if (= pos end)
|
||||
(if (fx= pos end)
|
||||
(set! write-pos #f)
|
||||
(set! write-pos pos))])
|
||||
;; discard-all
|
||||
|
|
@ -169,10 +170,10 @@
|
|||
[else
|
||||
(define pos start)
|
||||
(check-output-unblocking)
|
||||
(unless (eqv? 0 peeked-amt)
|
||||
(set! peeked-amt (max 0 (sub1 peeked-amt))))
|
||||
(define new-pos (add1 pos))
|
||||
(if (= new-pos len)
|
||||
(unless (fx= 0 peeked-amt)
|
||||
(set! peeked-amt (fxmax 0 (fx- peeked-amt 1))))
|
||||
(define new-pos (fx+ pos 1))
|
||||
(if (fx= new-pos len)
|
||||
(set! start 0)
|
||||
(set! start new-pos))
|
||||
(check-input-blocking)
|
||||
|
|
@ -191,19 +192,19 @@
|
|||
(check-output-unblocking)
|
||||
(begin0
|
||||
(cond
|
||||
[(start . < . end)
|
||||
(define amt (min (- dest-end dest-start)
|
||||
(- end start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr start (+ start amt))
|
||||
(set! start (+ start amt))
|
||||
(set! peeked-amt (max 0 (- peeked-amt amt)))
|
||||
[(start . fx< . end)
|
||||
(define amt (fxmin (fx- dest-end dest-start)
|
||||
(fx- end start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr start (fx+ start amt))
|
||||
(set! start (fx+ start amt))
|
||||
(set! peeked-amt (fxmax 0 (fx- peeked-amt amt)))
|
||||
amt]
|
||||
[else
|
||||
(define amt (min (- dest-end dest-start)
|
||||
(- len start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr start (+ start amt))
|
||||
(set! start (modulo (+ start amt) len))
|
||||
(set! peeked-amt (max 0 (- peeked-amt amt)))
|
||||
(define amt (fxmin (fx- dest-end dest-start)
|
||||
(fx- len start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr start (fx+ start amt))
|
||||
(set! start (modulo (fx+ start amt) len))
|
||||
(set! peeked-amt (fxmax 0 (fx- peeked-amt amt)))
|
||||
amt])
|
||||
(check-input-blocking)
|
||||
(progress!))]))
|
||||
|
|
@ -240,18 +241,18 @@
|
|||
(lambda (v) 0))))
|
||||
evt])]
|
||||
[else
|
||||
(define peek-start (modulo (+ start skip) len))
|
||||
(define peek-start (fxmodulo (fx+ start skip) len))
|
||||
(cond
|
||||
[(peek-start . < . end)
|
||||
(define amt (min (- dest-end dest-start)
|
||||
(- end peek-start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr peek-start (+ peek-start amt))
|
||||
[(peek-start . fx< . end)
|
||||
(define amt (fxmin (fx- dest-end dest-start)
|
||||
(fx- end peek-start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr peek-start (fx+ peek-start amt))
|
||||
(peeked! (+ skip amt))
|
||||
amt]
|
||||
[else
|
||||
(define amt (min (- dest-end dest-start)
|
||||
(- len peek-start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr peek-start (+ peek-start amt))
|
||||
(define amt (fxmin (fx- dest-end dest-start)
|
||||
(fx- len peek-start)))
|
||||
(bytes-copy! dest-bstr dest-start bstr peek-start (fx+ peek-start amt))
|
||||
(peeked! (+ skip amt))
|
||||
amt])]))
|
||||
|
||||
|
|
@ -259,7 +260,7 @@
|
|||
(lambda (work-done!)
|
||||
(assert-atomic)
|
||||
(or output-closed?
|
||||
(not (zero? (content-length)))))
|
||||
(not (fx= 0 (content-length)))))
|
||||
|
||||
#:close
|
||||
(lambda ()
|
||||
|
|
@ -294,20 +295,20 @@
|
|||
(lambda ()
|
||||
(let ([amt (min amt (content-length))])
|
||||
(cond
|
||||
[(zero? amt)
|
||||
[(fx= 0 amt)
|
||||
;; There was nothing to commit; claim success for 0 bytes
|
||||
(finish #"")]
|
||||
[else
|
||||
(define dest-bstr (make-bytes amt))
|
||||
(cond
|
||||
[(start . < . end)
|
||||
(bytes-copy! dest-bstr 0 bstr start (+ start amt))]
|
||||
[(start . fx< . end)
|
||||
(bytes-copy! dest-bstr 0 bstr start (fx+ start amt))]
|
||||
[else
|
||||
(define amt1 (min (- len start) amt))
|
||||
(bytes-copy! dest-bstr 0 bstr start (+ start amt1))
|
||||
(when (amt1 . < . amt)
|
||||
(bytes-copy! dest-bstr amt1 bstr 0 (- amt amt1)))])
|
||||
(set! start (modulo (+ start amt) len))
|
||||
(define amt1 (fxmin (fx- len start) amt))
|
||||
(bytes-copy! dest-bstr 0 bstr start (fx+ start amt1))
|
||||
(when (amt1 . fx< . amt)
|
||||
(bytes-copy! dest-bstr amt1 bstr 0 (fx- amt amt1)))])
|
||||
(set! start (fxmodulo (fx+ start amt) len))
|
||||
(progress!)
|
||||
(check-input-blocking)
|
||||
(finish dest-bstr)]))))]))))
|
||||
|
|
@ -325,23 +326,23 @@
|
|||
(lambda (src-bstr src-start src-end nonblock? enable-break? copy?)
|
||||
(assert-atomic)
|
||||
(let try-again ()
|
||||
(define top-pos (if (zero? start)
|
||||
(sub1 len)
|
||||
(define top-pos (if (fx= start 0)
|
||||
(fx- len 1)
|
||||
len))
|
||||
(define (maybe-grow)
|
||||
(cond
|
||||
[(or (not limit)
|
||||
((+ limit peeked-amt) . > . (sub1 len)))
|
||||
((+ limit peeked-amt) . > . (fx- len 1)))
|
||||
;; grow pipe size
|
||||
(define new-bstr (make-bytes (min+1 (and limit (+ limit peeked-amt)) (* len 2))))
|
||||
(cond
|
||||
[(zero? start)
|
||||
(bytes-copy! new-bstr 0 bstr 0 (sub1 len))]
|
||||
[(fx= 0 start)
|
||||
(bytes-copy! new-bstr 0 bstr 0 (fx- len 1))]
|
||||
[else
|
||||
(bytes-copy! new-bstr 0 bstr start len)
|
||||
(bytes-copy! new-bstr (- len start) bstr 0 end)
|
||||
(bytes-copy! new-bstr (fx- len start) bstr 0 end)
|
||||
(set! start 0)
|
||||
(set! end (sub1 len))])
|
||||
(set! end (fx- len 1))])
|
||||
(set! bstr new-bstr)
|
||||
(set! len (bytes-length new-bstr))
|
||||
(try-again)]
|
||||
|
|
@ -353,59 +354,59 @@
|
|||
(min amt (- (+ limit peeked-amt) (content-length)))
|
||||
amt))
|
||||
(cond
|
||||
[(= src-start src-end) ;; => flush
|
||||
[(fx= src-start src-end) ;; => flush
|
||||
0]
|
||||
[write-pos ; set by `file-position` on a bytes port
|
||||
(define amt (apply-limit (min (- end write-pos)
|
||||
(- src-end src-start))))
|
||||
(define amt (apply-limit (fxmin (fx- end write-pos)
|
||||
(fx- src-end src-start))))
|
||||
(cond
|
||||
[(zero? amt) (pipe-is-full)]
|
||||
[(fx= amt 0) (pipe-is-full)]
|
||||
[else
|
||||
(check-input-unblocking)
|
||||
(bytes-copy! bstr write-pos src-bstr src-start (+ src-start amt))
|
||||
(let ([new-write-pos (+ write-pos amt)])
|
||||
(if (= new-write-pos end)
|
||||
(bytes-copy! bstr write-pos src-bstr src-start (fx+ src-start amt))
|
||||
(let ([new-write-pos (fx+ write-pos amt)])
|
||||
(if (fx= new-write-pos end)
|
||||
(set! write-pos #f) ; back to normal mode
|
||||
(set! write-pos new-write-pos)))
|
||||
(check-output-blocking)
|
||||
amt])]
|
||||
[(and (end . >= . start)
|
||||
(end . < . top-pos))
|
||||
(define amt (apply-limit (min (- top-pos end)
|
||||
(- src-end src-start))))
|
||||
[(and (end . fx>= . start)
|
||||
(end . fx< . top-pos))
|
||||
(define amt (apply-limit (fxmin (fx- top-pos end)
|
||||
(fx- src-end src-start))))
|
||||
(cond
|
||||
[(zero? amt) (pipe-is-full)]
|
||||
[(fx= amt 0) (pipe-is-full)]
|
||||
[else
|
||||
(check-input-unblocking)
|
||||
(bytes-copy! bstr end src-bstr src-start (+ src-start amt))
|
||||
(let ([new-end (+ end amt)])
|
||||
(set! end (if (= new-end len) 0 new-end)))
|
||||
(bytes-copy! bstr end src-bstr src-start (fx+ src-start amt))
|
||||
(let ([new-end (fx+ end amt)])
|
||||
(set! end (if (fx= new-end len) 0 new-end)))
|
||||
(check-output-blocking)
|
||||
amt])]
|
||||
[(= end top-pos)
|
||||
[(fx= end top-pos)
|
||||
(cond
|
||||
[(zero? start)
|
||||
[(fx= start 0)
|
||||
(maybe-grow)]
|
||||
[else
|
||||
(define amt (min (sub1 start)
|
||||
(- src-end src-start)))
|
||||
(define amt (fxmin (fx- start 1)
|
||||
(fx- src-end src-start)))
|
||||
(cond
|
||||
[(zero? amt) (pipe-is-full)]
|
||||
[(fx= amt 0) (pipe-is-full)]
|
||||
[else
|
||||
(check-input-unblocking)
|
||||
(bytes-copy! bstr 0 src-bstr src-start (+ src-start amt))
|
||||
(bytes-copy! bstr 0 src-bstr src-start (fx+ src-start amt))
|
||||
(set! end amt)
|
||||
(check-output-blocking)
|
||||
amt])])]
|
||||
[(end . < . (sub1 start))
|
||||
(define amt (apply-limit (min (- (sub1 start) end)
|
||||
(- src-end src-start))))
|
||||
[(end . fx< . (fx- start 1))
|
||||
(define amt (apply-limit (fxmin (fx- (fx- start 1) end)
|
||||
(fx- src-end src-start))))
|
||||
(cond
|
||||
[(zero? amt) (pipe-is-full)]
|
||||
[(fx= amt 0) (pipe-is-full)]
|
||||
[else
|
||||
(check-input-unblocking)
|
||||
(bytes-copy! bstr end src-bstr src-start (+ src-start amt))
|
||||
(set! end (+ end amt))
|
||||
(bytes-copy! bstr end src-bstr src-start (fx+ src-start amt))
|
||||
(set! end (fx+ end amt))
|
||||
(check-output-blocking)
|
||||
amt])]
|
||||
[else
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
#lang racket/base
|
||||
(require racket/fixnum)
|
||||
|
||||
(provide utf-8-decode!
|
||||
utf-8-max-aborts-amt
|
||||
|
|
@ -42,7 +43,7 @@
|
|||
#:state [state #f]) ; state that was returned in place of a previous 'aborts result
|
||||
(define base-i ; start of current encoding sequence
|
||||
(if state
|
||||
(- in-start (utf-8-state-pending-amt state))
|
||||
(fx- in-start (utf-8-state-pending-amt state))
|
||||
in-start))
|
||||
(define accum ; accumulated value for encoding
|
||||
(if state
|
||||
|
|
@ -61,29 +62,29 @@
|
|||
(cond
|
||||
[error-ch
|
||||
(when out-str (string-set! out-str j error-ch))
|
||||
(define next-j (add1 j))
|
||||
(define next-i (add1 base-i))
|
||||
(define next-j (fx+ j 1))
|
||||
(define next-i (fx+ base-i 1))
|
||||
(cond
|
||||
[(and out-end (= next-j out-end))
|
||||
(values (- next-i in-start)
|
||||
(- next-j out-start)
|
||||
[(and out-end (fx= next-j out-end))
|
||||
(values (fx- next-i in-start)
|
||||
(fx- next-j out-start)
|
||||
'continues)]
|
||||
[else
|
||||
(loop next-i next-j next-i 0 0)])]
|
||||
[else
|
||||
(values (- base-i in-start)
|
||||
(- j out-start)
|
||||
(values (fx- base-i in-start)
|
||||
(fx- j out-start)
|
||||
'error)]))
|
||||
|
||||
;; Shared handling for decoding success:
|
||||
(define (continue)
|
||||
(define next-j (add1 j))
|
||||
(define next-i (add1 i))
|
||||
(define next-j (fx+ j 1))
|
||||
(define next-i (fx+ i 1))
|
||||
(cond
|
||||
[(and out-end (= next-j out-end))
|
||||
(values (- next-i in-start)
|
||||
(- next-j out-start)
|
||||
(if (= next-i in-end)
|
||||
[(and out-end (fx= next-j out-end))
|
||||
(values (fx- next-i in-start)
|
||||
(fx- next-j out-start)
|
||||
(if (fx= next-i in-end)
|
||||
'complete
|
||||
'continues))]
|
||||
[else
|
||||
|
|
@ -91,24 +92,24 @@
|
|||
|
||||
;; Dispatch on byte:
|
||||
(cond
|
||||
[(= i in-end)
|
||||
[(fx= i in-end)
|
||||
;; End of input
|
||||
(cond
|
||||
[(zero? remaining)
|
||||
(values (- base-i in-start)
|
||||
(- j out-start)
|
||||
[(fx= remaining 0)
|
||||
(values (fx- base-i in-start)
|
||||
(fx- j out-start)
|
||||
'complete)]
|
||||
[(eq? abort-mode 'error)
|
||||
(encoding-failure)]
|
||||
[(eq? abort-mode 'state)
|
||||
(values (- i in-start) ; all bytes used
|
||||
(- j out-start)
|
||||
(utf-8-state accum remaining (- i base-i)))]
|
||||
(values (fx- i in-start) ; all bytes used
|
||||
(fx- j out-start)
|
||||
(utf-8-state accum remaining (fx- i base-i)))]
|
||||
[else
|
||||
(values (- base-i in-start)
|
||||
(- j out-start)
|
||||
(values (fx- base-i in-start)
|
||||
(fx- j out-start)
|
||||
'aborts)])]
|
||||
[(i . < . in-start)
|
||||
[(i . fx< . in-start)
|
||||
;; Happens only if we resume decoding with some state
|
||||
;; and hit a decoding error; treat the byte as another
|
||||
;; encoding error
|
||||
|
|
@ -116,9 +117,9 @@
|
|||
[else
|
||||
(define b (bytes-ref in-bstr i))
|
||||
(cond
|
||||
[(b . < . 128)
|
||||
[(b . fx< . 128)
|
||||
(cond
|
||||
[(zero? remaining)
|
||||
[(fx= remaining 0)
|
||||
;; Found ASCII
|
||||
(when out-str (string-set! out-str j (integer->char b)))
|
||||
(continue)]
|
||||
|
|
@ -129,14 +130,14 @@
|
|||
[else
|
||||
;; Encoding...
|
||||
(cond
|
||||
[(= #b10000000 (bitwise-and b #b11000000))
|
||||
[(fx= #b10000000 (fxand b #b11000000))
|
||||
;; A continuation byte
|
||||
(cond
|
||||
[(zero? remaining)
|
||||
[(fx= remaining 0)
|
||||
;; We weren't continuing
|
||||
(encoding-failure)]
|
||||
[else
|
||||
(define next (bitwise-and b #b00111111))
|
||||
(define next (fxand b #b00111111))
|
||||
(define next-accum (bitwise-ior (arithmetic-shift accum 6) next))
|
||||
(cond
|
||||
[(= 1 remaining)
|
||||
|
|
@ -150,38 +151,38 @@
|
|||
[else
|
||||
;; Not a valid character
|
||||
(encoding-failure)])]
|
||||
[(and (= 2 remaining)
|
||||
[(and (fx= 2 remaining)
|
||||
(next-accum . <= . #b11111))
|
||||
;; A shorter byte sequence would work, so this is an
|
||||
;; encoding mistae.
|
||||
(encoding-failure)]
|
||||
[(and (= 3 remaining)
|
||||
[(and (fx= 3 remaining)
|
||||
(next-accum . <= . #b1111))
|
||||
;; A shorter byte sequence would work
|
||||
(encoding-failure)]
|
||||
[else
|
||||
;; Continue an encoding.
|
||||
(loop (add1 i) j base-i next-accum (sub1 remaining))])])]
|
||||
[(not (zero? remaining))
|
||||
(loop (fx+ i 1) j base-i next-accum (fx- remaining 1))])])]
|
||||
[(not (fx= remaining 0))
|
||||
;; Trying to start a new encoding while one is in
|
||||
;; progress
|
||||
(encoding-failure)]
|
||||
[(= #b11000000 (bitwise-and b #b11100000))
|
||||
[(fx= #b11000000 (fxand b #b11100000))
|
||||
;; Start a two-byte encoding
|
||||
(define accum (bitwise-and b #b11111))
|
||||
(define accum (fxand b #b11111))
|
||||
;; If `accum` is zero, that's an encoding mistake,
|
||||
;; because a shorted byte sequence would work.
|
||||
(cond
|
||||
[(zero? accum) (encoding-failure)]
|
||||
[else (loop (add1 i) j i accum 1)])]
|
||||
[(= #b11100000 (bitwise-and b #b11110000))
|
||||
[(fx= accum 0) (encoding-failure)]
|
||||
[else (loop (fx+ i 1) j i accum 1)])]
|
||||
[(fx= #b11100000 (fxand b #b11110000))
|
||||
;; Start a three-byte encoding
|
||||
(define accum (bitwise-and b #b1111))
|
||||
(loop (add1 i) j i accum 2)]
|
||||
[(= #b11110000 (bitwise-and b #b11111000))
|
||||
(define accum (fxand b #b1111))
|
||||
(loop (fx+ i 1) j i accum 2)]
|
||||
[(fx= #b11110000 (fxand b #b11111000))
|
||||
;; Start a four-byte encoding
|
||||
(define accum (bitwise-and b #b111))
|
||||
(loop (add1 i) j i accum 3)]
|
||||
(define accum (fxand b #b111))
|
||||
(loop (fx+ i 1) j i accum 3)]
|
||||
[else
|
||||
;; Five- or six-byte encodings don't produce valid
|
||||
;; characters
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
(require racket/fixnum)
|
||||
|
||||
(provide utf-8-encode!
|
||||
|
||||
utf-8-encode-dispatch)
|
||||
|
||||
;; Returns (values chars-used bytes-written (or/c 'complete 'continues))
|
||||
|
|
@ -12,11 +12,11 @@
|
|||
;; Iterate through the given string
|
||||
(let loop ([i in-start] [j out-start])
|
||||
(cond
|
||||
[(= i in-end)
|
||||
(values (- in-end in-start) (- j out-start) 'complete)]
|
||||
[(fx= i in-end)
|
||||
(values (fx- in-end in-start) (fx- j out-start) 'complete)]
|
||||
[else
|
||||
(define b (char->integer (string-ref in-str i)))
|
||||
(define (continue next-j) (loop (add1 i) next-j))
|
||||
(define (continue next-j) (loop (fx+ i 1) next-j))
|
||||
(utf-8-encode-dispatch b
|
||||
in-start i
|
||||
out-bstr out-start out-end j
|
||||
|
|
@ -30,40 +30,40 @@
|
|||
[(b . <= . #x7F)
|
||||
(cond
|
||||
[(and out-end (= j out-end))
|
||||
(values (- i in-start) (- j out-start) 'continues)]
|
||||
(values (fx- i in-start) (fx- j out-start) 'continues)]
|
||||
[else
|
||||
(when out-bstr (bytes-set! out-bstr j b))
|
||||
(continue (add1 j))])]
|
||||
(continue (fx+ j 1))])]
|
||||
[(b . <= . #x7FF)
|
||||
(cond
|
||||
[(and out-end ((add1 j) . >= . out-end))
|
||||
(values (- i in-start) (- j out-start) 'continues)]
|
||||
[(and out-end ((fx+ j 1) . fx>= . out-end))
|
||||
(values (fx- i in-start) (fx- j out-start) 'continues)]
|
||||
[else
|
||||
(when out-bstr
|
||||
(bytes-set! out-bstr j (bitwise-ior #b11000000 (arithmetic-shift b -6)))
|
||||
(bytes-set! out-bstr (add1 j) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
|
||||
(continue (+ j 2))])]
|
||||
[(b . <= . #xFFFF)
|
||||
[(b . fx<= . #xFFFF)
|
||||
(cond
|
||||
[(and out-end ((+ j 2) . >= . out-end))
|
||||
(values (- i in-start) (- j out-start) 'continues)]
|
||||
[(and out-end ((fx+ j 2) . fx>= . out-end))
|
||||
(values (fx- i in-start) (fx- j out-start) 'continues)]
|
||||
[else
|
||||
(when out-bstr
|
||||
(bytes-set! out-bstr j (bitwise-ior #b11100000 (arithmetic-shift b -12)))
|
||||
(bytes-set! out-bstr (+ j 1) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6)
|
||||
(bytes-set! out-bstr (fx+ j 1) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6)
|
||||
#b111111)))
|
||||
(bytes-set! out-bstr (+ j 2) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
|
||||
(continue (+ j 3))])]
|
||||
(bytes-set! out-bstr (fx+ j 2) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
|
||||
(continue (fx+ j 3))])]
|
||||
[else
|
||||
(cond
|
||||
[(and out-end ((+ j 3) . >= . out-end))
|
||||
(values (- i in-start) (- j out-start) 'continues)]
|
||||
[(and out-end ((fx+ j 3) . fx>= . out-end))
|
||||
(values (fx- i in-start) (fx- j out-start) 'continues)]
|
||||
[else
|
||||
(when out-bstr
|
||||
(bytes-set! out-bstr j (bitwise-ior #b11110000 (arithmetic-shift b -18)))
|
||||
(bytes-set! out-bstr (+ j 1) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -12)
|
||||
#b111111)))
|
||||
(bytes-set! out-bstr (+ j 2) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6)
|
||||
#b111111)))
|
||||
(bytes-set! out-bstr (+ j 3) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
|
||||
(continue (+ j 4))])]))
|
||||
(bytes-set! out-bstr (fx+ j 1) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -12)
|
||||
#b111111)))
|
||||
(bytes-set! out-bstr (fx+ j 2) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6)
|
||||
#b111111)))
|
||||
(bytes-set! out-bstr (fx+ j 3) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
|
||||
(continue (fx+ j 4))])]))
|
||||
|
|
|
|||
|
|
@ -49416,12 +49416,12 @@ static const char *startup_source =
|
|||
"(let-values(((pos_0)(accum-string-pos a_0)))"
|
||||
"(let-values(((str_0)(accum-string-str a_0)))"
|
||||
"(let-values(((str2_0)"
|
||||
"(if(< pos_0(string-length str_0))"
|
||||
"(if(fx< pos_0(string-length str_0))"
|
||||
"(let-values() str_0)"
|
||||
"(let-values()"
|
||||
"(let-values(((str2_0)(make-string(*(string-length str_0) 2))))"
|
||||
"(let-values(((str2_0)(make-string(fx*(string-length str_0) 2))))"
|
||||
"(begin(string-copy! str2_0 0 str_0)(set-accum-string-str! a_0 str2_0) str2_0))))))"
|
||||
"(begin(string-set! str2_0 pos_0 c_0)(set-accum-string-pos! a_0(add1 pos_0)))))))))"
|
||||
"(begin(string-set! str2_0 pos_0 c_0)(set-accum-string-pos! a_0(fx+ 1 pos_0)))))))))"
|
||||
"(define-values(accum-string-count)(lambda(a_0)(begin(accum-string-pos a_0))))"
|
||||
"(define-values(set-accum-string-count!)(lambda(a_0 pos_0)(begin(set-accum-string-pos! a_0 pos_0))))"
|
||||
"(define-values"
|
||||
|
|
@ -49432,13 +49432,13 @@ static const char *startup_source =
|
|||
"(let-values(((s_0)(convert_0(substring str_0 start-pos_0(accum-string-pos a_0)))))"
|
||||
"(let-values(((len_0)(string-length s_0)))"
|
||||
"(begin"
|
||||
"(if(<(+ len_0 start-pos_0)(string-length str_0))"
|
||||
"(if(fx<(fx+ len_0 start-pos_0)(string-length str_0))"
|
||||
"(void)"
|
||||
"(let-values()"
|
||||
"(let-values(((str2_0)(make-string(+ start-pos_0 len_0))))"
|
||||
"(let-values(((str2_0)(make-string(fx+ start-pos_0 len_0))))"
|
||||
"(begin(string-copy! str2_0 0 str_0 0 start-pos_0)(set-accum-string-str! a_0 str2_0)))))"
|
||||
"(string-copy!(accum-string-str a_0) start-pos_0 s_0)"
|
||||
"(set-accum-string-pos! a_0(+ start-pos_0 len_0)))))))))"
|
||||
"(set-accum-string-pos! a_0(fx+ start-pos_0 len_0)))))))))"
|
||||
"(define-values"
|
||||
"(accum-string-get!6.1)"
|
||||
"(lambda(start-pos2_0 a4_0 config5_0)"
|
||||
|
|
@ -50162,7 +50162,7 @@ static const char *startup_source =
|
|||
"(let-values(((in-complex_0) in-complex8_0))"
|
||||
"(let-values(((convert-mode_0) convert-mode16_0))"
|
||||
"(let-values()"
|
||||
"(if(= start_0 end_0)"
|
||||
"(if(fx= start_0 end_0)"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
" (let-values () (format \"no digits\"))"
|
||||
|
|
@ -50171,8 +50171,8 @@ static const char *startup_source =
|
|||
"(let-values(((c_0)(string-ref s_0 start_0)))"
|
||||
"(if(char=? '#\\# c_0)"
|
||||
"(let-values()"
|
||||
"(let-values(((next_0)(add1 start_0)))"
|
||||
"(if(= next_0 end_0)"
|
||||
"(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))"
|
||||
|
|
@ -50269,7 +50269,7 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(let-values()"
|
||||
"(let-values(((s73_0) s_0)"
|
||||
"((temp74_0)(add1 next_0))"
|
||||
"((temp74_0)(fx+ 1 next_0))"
|
||||
"((end75_0) end_0)"
|
||||
"((radix76_0) radix_0)"
|
||||
"((radix-set?77_0) radix-set?_0)"
|
||||
|
|
@ -50318,7 +50318,7 @@ static const char *startup_source =
|
|||
"(let-values() 10)"
|
||||
"(let-values() 16)))))))"
|
||||
"(let-values(((s80_0) s_0)"
|
||||
"((temp81_0)(add1 next_0))"
|
||||
"((temp81_0)(fx+ 1 next_0))"
|
||||
"((end82_0) end_0)"
|
||||
"((radix83_0) radix_1)"
|
||||
"((temp84_0) #t)"
|
||||
|
|
@ -50352,13 +50352,13 @@ static const char *startup_source =
|
|||
"(let-values(((c2_0)"
|
||||
"(if(char-sign? c_0)"
|
||||
"(if(not in-complex_0)"
|
||||
"(if(>(- end_0 start_0) 7)"
|
||||
"(if(char=? '#\\i(string-ref s_0(sub1 end_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"
|
||||
"(+ start_0 6)"
|
||||
"(fx+ start_0 6)"
|
||||
" convert-mode_0)"
|
||||
" #f)"
|
||||
" #f)"
|
||||
|
|
@ -50368,8 +50368,8 @@ static const char *startup_source =
|
|||
"(if c2_0"
|
||||
"((lambda(v_0)"
|
||||
"(let-values(((s87_0) s_0)"
|
||||
"((temp88_0)(+ start_0 6))"
|
||||
"((temp89_0)(sub1 end_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)"
|
||||
|
|
@ -50392,13 +50392,13 @@ static const char *startup_source =
|
|||
" c2_0)"
|
||||
"(let-values(((c3_0)"
|
||||
"(if(not in-complex_0)"
|
||||
"(if(>=(- end_0 start_0) 7)"
|
||||
"(if(char=? '#\\i(string-ref s_0(sub1 end_0)))"
|
||||
"(if(char-sign?(string-ref s_0(- end_0 7)))"
|
||||
"(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"
|
||||
"(- end_0 7)"
|
||||
"(sub1 end_0)"
|
||||
"(fx- end_0 7)"
|
||||
"(fx- end_0 1)"
|
||||
" convert-mode_0)"
|
||||
" #f)"
|
||||
" #f)"
|
||||
|
|
@ -50406,12 +50406,12 @@ static const char *startup_source =
|
|||
" #f)))"
|
||||
"(if c3_0"
|
||||
"((lambda(v2_0)"
|
||||
"(if(if(= start_0(- end_0 7))(not(extflonum? v2_0)) #f)"
|
||||
"(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)(- end_0 7))"
|
||||
"((temp98_0)(fx- end_0 7))"
|
||||
"((radix99_0) radix_0)"
|
||||
"((exactness100_0) exactness_0)"
|
||||
"((convert-mode101_0) convert-mode_0)"
|
||||
|
|
@ -50436,12 +50436,12 @@ static const char *startup_source =
|
|||
"(let-values(((c4_0)"
|
||||
"(if(char-sign? c_0)"
|
||||
"(if(not in-complex_0)"
|
||||
"(if(>(- end_0 start_0) 7)"
|
||||
"(if(char=? '#\\@(string-ref s_0(+ start_0 6)))"
|
||||
"(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"
|
||||
"(+ start_0 6)"
|
||||
"(fx+ start_0 6)"
|
||||
" convert-mode_0)"
|
||||
" #f)"
|
||||
" #f)"
|
||||
|
|
@ -50450,7 +50450,7 @@ static const char *startup_source =
|
|||
"(if c4_0"
|
||||
"((lambda(v_0)"
|
||||
"(let-values(((s106_0) s_0)"
|
||||
"((temp107_0)(+ start_0 7))"
|
||||
"((temp107_0)(fx+ start_0 7))"
|
||||
"((end108_0) end_0)"
|
||||
"((radix109_0) radix_0)"
|
||||
"((exactness110_0) exactness_0)"
|
||||
|
|
@ -50474,11 +50474,11 @@ static const char *startup_source =
|
|||
" c4_0)"
|
||||
"(let-values(((c5_0)"
|
||||
"(if(not in-complex_0)"
|
||||
"(if(>(- end_0 start_0) 7)"
|
||||
"(if(char=? '#\\@(string-ref s_0(- end_0 7)))"
|
||||
"(if(fx>(fx- end_0 start_0) 7)"
|
||||
"(if(char=? '#\\@(string-ref s_0(fx- end_0 7)))"
|
||||
"(read-special-number"
|
||||
" s_0"
|
||||
"(- end_0 6)"
|
||||
"(fx- end_0 6)"
|
||||
" end_0"
|
||||
" convert-mode_0)"
|
||||
" #f)"
|
||||
|
|
@ -50488,7 +50488,7 @@ static const char *startup_source =
|
|||
"((lambda(v2_0)"
|
||||
"(let-values(((s115_0) s_0)"
|
||||
"((start116_0) start_0)"
|
||||
"((temp117_0)(- end_0 7))"
|
||||
"((temp117_0)(fx- end_0 7))"
|
||||
"((radix118_0) radix_0)"
|
||||
"((exactness119_0) exactness_0)"
|
||||
"((convert-mode120_0) convert-mode_0)"
|
||||
|
|
@ -50555,7 +50555,7 @@ static const char *startup_source =
|
|||
" must-i?_0)"
|
||||
"(begin"
|
||||
" 'loop"
|
||||
"(if(= i_0 end_0)"
|
||||
"(if(fx= i_0 end_0)"
|
||||
"(let-values()"
|
||||
"(if(if(not any-digits?_0)(not i-pos_0) #f)"
|
||||
"(let-values()"
|
||||
|
|
@ -50573,10 +50573,10 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(if(if sign-pos_0"
|
||||
"(let-values(((or-part_0)"
|
||||
"(if dot-pos_0(< dot-pos_0 sign-pos_0) #f)))"
|
||||
"(if dot-pos_0(fx< dot-pos_0 sign-pos_0) #f)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(if slash-pos_0(< slash-pos_0 sign-pos_0) #f)))"
|
||||
"(if slash-pos_0(fx< slash-pos_0 sign-pos_0) #f)))"
|
||||
" #f)"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
|
|
@ -50591,7 +50591,7 @@ static const char *startup_source =
|
|||
"((start134_0) start_0)"
|
||||
"((sign-pos135_0) sign-pos_0)"
|
||||
"((sign-pos136_0) sign-pos_0)"
|
||||
"((temp137_0)(sub1 end_0))"
|
||||
"((temp137_0)(fx- end_0 1))"
|
||||
"((i-pos138_0) i-pos_0)"
|
||||
"((sign-pos139_0) sign-pos_0)"
|
||||
"((radix140_0) radix_0)"
|
||||
|
|
@ -50617,7 +50617,7 @@ static const char *startup_source =
|
|||
"(let-values(((s145_0) s_0)"
|
||||
"((start146_0) start_0)"
|
||||
"((@-pos147_0) @-pos_0)"
|
||||
"((temp148_0)(add1 @-pos_0))"
|
||||
"((temp148_0)(fx+ 1 @-pos_0))"
|
||||
"((end149_0) end_0)"
|
||||
"((i-pos150_0) i-pos_0)"
|
||||
"((sign-pos151_0) sign-pos_0)"
|
||||
|
|
@ -50656,7 +50656,7 @@ static const char *startup_source =
|
|||
"(if(digit? c_0 radix_0)"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" #t"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50669,7 +50669,7 @@ static const char *startup_source =
|
|||
"(if(char=? c_0 '#\\#)"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" #t"
|
||||
" #t"
|
||||
" i-pos_0"
|
||||
|
|
@ -50691,7 +50691,7 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50700,9 +50700,9 @@ static const char *startup_source =
|
|||
" dot-pos_0"
|
||||
" slash-pos_0"
|
||||
" #f"
|
||||
"(if(> i_0 start_0)"
|
||||
"(if(fx> i_0 start_0)"
|
||||
"(let-values(((or-part_0)(not @-pos_0)))"
|
||||
"(if or-part_0 or-part_0(> i_0(add1 @-pos_0))))"
|
||||
"(if or-part_0 or-part_0(fx> i_0(fx+ 1 @-pos_0))))"
|
||||
" #f)))))"
|
||||
"(if(char=? c_0 '#\\.)"
|
||||
"(let-values()"
|
||||
|
|
@ -50712,7 +50712,7 @@ static const char *startup_source =
|
|||
"(not sign-pos_0)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(> exp-pos_0 sign-pos_0)))"
|
||||
"(fx> exp-pos_0 sign-pos_0)))"
|
||||
" #f)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
|
|
@ -50720,7 +50720,7 @@ static const char *startup_source =
|
|||
"(let-values(((or-part_1)(not sign-pos_0)))"
|
||||
"(if or-part_1"
|
||||
" or-part_1"
|
||||
"(> dot-pos_0 sign-pos_0)))"
|
||||
"(fx> dot-pos_0 sign-pos_0)))"
|
||||
" #f)))"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
|
|
@ -50733,7 +50733,7 @@ static const char *startup_source =
|
|||
"(let-values(((or-part_0)(not sign-pos_0)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(> slash-pos_0 sign-pos_0)))"
|
||||
"(fx> slash-pos_0 sign-pos_0)))"
|
||||
" #f)"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
|
|
@ -50744,7 +50744,7 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50760,7 +50760,7 @@ static const char *startup_source =
|
|||
"(let-values(((or-part_0)(not sign-pos_0)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(> dot-pos_0 sign-pos_0)))"
|
||||
"(fx> dot-pos_0 sign-pos_0)))"
|
||||
" #f)"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
|
|
@ -50775,7 +50775,7 @@ static const char *startup_source =
|
|||
"(not sign-pos_0)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(> exp-pos_0 sign-pos_0)))"
|
||||
"(fx> exp-pos_0 sign-pos_0)))"
|
||||
" #f)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
|
|
@ -50783,7 +50783,7 @@ static const char *startup_source =
|
|||
"(let-values(((or-part_1)(not sign-pos_0)))"
|
||||
"(if or-part_1"
|
||||
" or-part_1"
|
||||
"(> slash-pos_0 sign-pos_0)))"
|
||||
"(fx> slash-pos_0 sign-pos_0)))"
|
||||
" #f)))"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
|
|
@ -50794,7 +50794,7 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50868,12 +50868,12 @@ static const char *startup_source =
|
|||
" c_0"
|
||||
"(substring s_0 start_0 end_0)))"
|
||||
"(let-values() #f)))"
|
||||
"(if(if(<(add1 i_0) end_0)"
|
||||
"(char-sign?(string-ref s_0(add1 i_0)))"
|
||||
"(if(if(fx<(fx+ 1 i_0) end_0)"
|
||||
"(char-sign?(string-ref s_0(fx+ 1 i_0)))"
|
||||
" #f)"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(+ i_0 2)"
|
||||
"(fx+ i_0 2)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50886,7 +50886,7 @@ static const char *startup_source =
|
|||
" must-i?_0))"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(+ i_0 1)"
|
||||
"(fx+ i_0 1)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50918,7 +50918,7 @@ static const char *startup_source =
|
|||
" \"too many `@`s in `~.a`\""
|
||||
"(substring s_0 start_0 end_0)))"
|
||||
"(let-values() #f)))"
|
||||
"(if(= i_0 start_0)"
|
||||
"(if(fx= i_0 start_0)"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
"(let-values()"
|
||||
|
|
@ -50936,7 +50936,7 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i-pos_0"
|
||||
|
|
@ -50963,7 +50963,7 @@ static const char *startup_source =
|
|||
"(substring s_0 start_0 end_0)))"
|
||||
"(let-values() #f)))"
|
||||
"(if(let-values(((or-part_0)"
|
||||
"(<(add1 i_0) end_0)))"
|
||||
"(fx<(fx+ 1 i_0) end_0)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(eq? in-complex_0 'i)))"
|
||||
|
|
@ -50976,7 +50976,7 @@ static const char *startup_source =
|
|||
"(let-values() #f)))"
|
||||
"(let-values()"
|
||||
"(loop_0"
|
||||
"(add1 i_0)"
|
||||
"(fx+ 1 i_0)"
|
||||
" any-digits?_0"
|
||||
" any-hashes?_0"
|
||||
" i_0"
|
||||
|
|
@ -51039,7 +51039,7 @@ static const char *startup_source =
|
|||
"(let-values(((convert-mode_0) convert-mode46_0))"
|
||||
"(let-values()"
|
||||
"(let-values(((v1_0)"
|
||||
"(if(= start1_0 end1_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)"
|
||||
|
|
@ -51060,7 +51060,7 @@ static const char *startup_source =
|
|||
" exactness162_0"
|
||||
" convert-mode164_0))))))"
|
||||
"(let-values(((v2_0)"
|
||||
"(if(if(eq? in-complex_0 'i)(=(- end2_0 start2_0) 1) #f)"
|
||||
"(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)"
|
||||
|
|
@ -51128,10 +51128,10 @@ static const char *startup_source =
|
|||
" #f)"
|
||||
" #f)"
|
||||
" #f)))"
|
||||
"(let-values(((has-sign?_0)(if(> end_0 start_0)(char-sign?(string-ref s_0 start_0)) #f)))"
|
||||
"(if(=(- end_0 start_0)(+(if dot-pos_0 1 0)(if exp-pos_0 1 0)(if has-sign?_0 1 0)))"
|
||||
"(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(= end_0 start_0)"
|
||||
"(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)))"
|
||||
|
|
@ -51139,9 +51139,9 @@ static const char *startup_source =
|
|||
"(if simple?_0"
|
||||
"(let-values()"
|
||||
"(if(if exp-pos_0"
|
||||
"(="
|
||||
"(- exp-pos_0 start_0)"
|
||||
"(+(if(if dot-pos_0(< dot-pos_0 exp-pos_0) #f) 1 0)(if has-sign?_0 1 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)"
|
||||
|
|
@ -51149,10 +51149,10 @@ static const char *startup_source =
|
|||
" (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)(= exp-pos_0(sub1 end_0))))"
|
||||
"(let-values(((or-part_0)(fx= exp-pos_0(fx- end_0 1))))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(if(= exp-pos_0(- end_0 2))(char-sign?(string-ref s_0(sub1 end_0))) #f)))"
|
||||
"(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)"
|
||||
|
|
@ -51206,7 +51206,7 @@ static const char *startup_source =
|
|||
" 'exact"
|
||||
" convert-mode_0)))"
|
||||
"(let-values(((e-v_0)"
|
||||
"(string->exact-integer-number s_0(+ exp-pos_0 1) end_0 radix_0 convert-mode_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"
|
||||
|
|
@ -51283,7 +51283,7 @@ static const char *startup_source =
|
|||
"(let-values(((d-v_0)"
|
||||
"(string->real-number"
|
||||
" s_0"
|
||||
"(add1 slash-pos_0)"
|
||||
"(fx+ 1 slash-pos_0)"
|
||||
" end_0"
|
||||
" #f"
|
||||
" #f"
|
||||
|
|
@ -51310,7 +51310,7 @@ static const char *startup_source =
|
|||
"(let-values() d-v_0)"
|
||||
"(if(eqv? d-v_0 0)"
|
||||
"(let-values()"
|
||||
"(if(get-inexact?_0(add1 slash-pos_0))"
|
||||
"(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)"
|
||||
|
|
@ -51329,14 +51329,14 @@ static const char *startup_source =
|
|||
"(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(- end_0 start_0(if(if dot-pos_0 get-exact?_0 #f) 1 0)))))"
|
||||
"(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)"
|
||||
"(begin"
|
||||
" 'loop"
|
||||
"(if(< i_0 start_0)"
|
||||
"(if(fx< i_0 start_0)"
|
||||
"(let-values()"
|
||||
"(if(= hashes-pos_0 start_0)"
|
||||
"(if(fx= hashes-pos_0 start_0)"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
"(let-values()"
|
||||
|
|
@ -51352,7 +51352,7 @@ static const char *startup_source =
|
|||
" -0.0"
|
||||
"(exact->inexact n_0)))"
|
||||
"(if(if dot-pos_0 get-exact?_0 #f)"
|
||||
"(let-values()(/ n_0(expt 10(- end_0 dot-pos_0 1))))"
|
||||
"(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)))"
|
||||
|
|
@ -51360,30 +51360,33 @@ static const char *startup_source =
|
|||
"(let-values()"
|
||||
"(if get-exact?_0"
|
||||
"(let-values()"
|
||||
"(loop_0(sub1 i_0) j_0(if(= hashes-pos_0(add1 i_0)) i_0 hashes-pos_0)))"
|
||||
"(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"
|
||||
"(sub1 i_0)"
|
||||
"(sub1 j_0)"
|
||||
"(if(= hashes-pos_0(add1 i_0)) i_0 hashes-pos_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"
|
||||
"(sub1 i_0)"
|
||||
"(sub1 j_0)"
|
||||
"(if(= hashes-pos_0(add1 i_0)) i_0 hashes-pos_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(= hashes-pos_0(add1 i_0))"
|
||||
"(if(fx= hashes-pos_0(fx+ 1 i_0))"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
"(string-set! new-str_0 j_0 '#\\0)"
|
||||
"(loop_0(sub1 i_0)(sub1 j_0) i_0)))"
|
||||
"(loop_0(fx- i_0 1)(fx- j_0 1) i_0)))"
|
||||
"(let-values()"
|
||||
"(if(eq? convert-mode_0 'must-read)"
|
||||
"(let-values()"
|
||||
|
|
@ -51392,10 +51395,10 @@ static const char *startup_source =
|
|||
"(let-values()"
|
||||
"(begin"
|
||||
"(string-set! new-str_0 j_0 c_0)"
|
||||
"(loop_0(sub1 i_0)(sub1 j_0) hashes-pos_0)))))))))))))"
|
||||
"(loop_0(fx- i_0 1)(fx- j_0 1) hashes-pos_0)))))))))))))"
|
||||
" loop_0)"
|
||||
"(sub1 end_0)"
|
||||
"(sub1(string-length new-str_0))"
|
||||
"(fx- end_0 1)"
|
||||
"(fx-(string-length new-str_0) 1)"
|
||||
" end_0))))))"
|
||||
"(define-values"
|
||||
"(string->exact-integer-number)"
|
||||
|
|
@ -51418,27 +51421,27 @@ static const char *startup_source =
|
|||
"(read-special-number)"
|
||||
"(lambda(s_0 start_0 end_0 convert-mode_0)"
|
||||
"(begin"
|
||||
"(if(=(- end_0 start_0) 6)"
|
||||
"(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(+ start_0 1))) '#\\i)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 2))) '#\\n)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 3))) '#\\f)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 4))) '#\\.)"
|
||||
"(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(+ start_0 5))) '#\\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)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(let-values(((or-part_1)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 5))) '#\\f)"
|
||||
"(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)))"
|
||||
"(if or-part_1"
|
||||
" or-part_1"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 5))) '#\\t)"
|
||||
"(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)"
|
||||
|
|
@ -51449,19 +51452,19 @@ static const char *startup_source =
|
|||
" #f)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 1))) '#\\n)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 2))) '#\\a)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 3))) '#\\n)"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 4))) '#\\.)"
|
||||
"(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(+ start_0 5))) '#\\0) +nan.0 #f)))"
|
||||
"(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(+ start_0 5))) '#\\f) +nan.f #f)))"
|
||||
"(if(char=?(char-downcase(string-ref s_0(fx+ start_0 5))) '#\\f) +nan.f #f)))"
|
||||
"(if or-part_2"
|
||||
" or-part_2"
|
||||
"(if(char=?(char-downcase(string-ref s_0(+ start_0 5))) '#\\t)"
|
||||
"(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)"
|
||||
|
|
@ -51576,7 +51579,7 @@ static const char *startup_source =
|
|||
"(replace-hashes)"
|
||||
"(lambda(s_0 start_0 end_0)"
|
||||
"(begin"
|
||||
"(let-values(((new-s_0)(make-string(- end_0 start_0))))"
|
||||
"(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"
|
||||
|
|
@ -51621,7 +51624,7 @@ static const char *startup_source =
|
|||
"(define-values"
|
||||
"(maybe-substring)"
|
||||
"(lambda(s_0 start_0 end_0)"
|
||||
"(begin(if(if(= 0 start_0)(= end_0(string-length s_0)) #f) s_0(substring 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)"
|
||||
|
|
@ -51634,15 +51637,17 @@ static const char *startup_source =
|
|||
"(lambda(c_0 radix_0)"
|
||||
"(begin"
|
||||
"(let-values(((v_0)(char->integer c_0)))"
|
||||
"(let-values(((or-part_0)(if(>= v_0(char->integer '#\\0))(<(- v_0(char->integer '#\\0)) radix_0) #f)))"
|
||||
"(let-values(((or-part_0)(if(fx>= v_0(char->integer '#\\0))(fx<(fx- v_0(char->integer '#\\0)) radix_0) #f)))"
|
||||
"(if or-part_0"
|
||||
" or-part_0"
|
||||
"(if(> radix_0 10)"
|
||||
"(if(fx> radix_0 10)"
|
||||
"(let-values(((or-part_1)"
|
||||
"(if(>= v_0(char->integer '#\\a))(<(- v_0(-(char->integer '#\\a) 10)) radix_0) #f)))"
|
||||
"(if(fx>= v_0(char->integer '#\\a))"
|
||||
"(fx<(fx- v_0(fx-(char->integer '#\\a) 10)) radix_0)"
|
||||
" #f)))"
|
||||
"(if or-part_1"
|
||||
" or-part_1"
|
||||
"(if(>= v_0(char->integer '#\\A))(<(- v_0(-(char->integer '#\\A) 10)) radix_0) #f)))"
|
||||
"(if(fx>= v_0(char->integer '#\\A))(fx<(fx- v_0(fx-(char->integer '#\\A) 10)) radix_0) #f)))"
|
||||
" #f)))))))"
|
||||
"(define-values"
|
||||
"(fail-bad-number)"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user