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

io, read: use fixnum operators

Browse Source
This commit is contained in:
Matthew Flatt 2018-08-24 19:37:56 -06:00
parent d0eb8f6c53
commit aa75a2fd32
6 changed files with 358 additions and 349 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
racket/src/expander/read/accum-string.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "config.rkt") (require racket/fixnum
"config.rkt")
;; An `accum-string` is a buffer for accumulating characters. ;; An `accum-string` is a buffer for accumulating characters.
;; We cache the buffer in the config record so that it can ;; We cache the buffer in the config record so that it can
@ -33,15 +34,15 @@
(define str (accum-string-str a)) (define str (accum-string-str a))
(define str2 (define str2
(cond (cond
[(pos . < . (string-length str)) [(pos . fx< . (string-length str))
str] str]
[else [else
(define str2 (make-string (* (string-length str) 2))) (define str2 (make-string (fx* (string-length str) 2)))
(string-copy! str2 0 str) (string-copy! str2 0 str)
(set-accum-string-str! a str2) (set-accum-string-str! a str2)
str2])) str2]))
(string-set! str2 pos c) (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) (define (accum-string-count a)
(accum-string-pos a)) (accum-string-pos a))
@ -58,12 +59,12 @@
start-pos start-pos
(accum-string-pos a)))) (accum-string-pos a))))
(define len (string-length s)) (define len (string-length s))
(unless ((+ len start-pos) . < . (string-length str)) (unless ((fx+ len start-pos) . fx< . (string-length str))
(define str2 (make-string (+ start-pos len))) (define str2 (make-string (fx+ start-pos len)))
(string-copy! str2 0 str 0 start-pos) (string-copy! str2 0 str 0 start-pos)
(set-accum-string-str! a str2)) (set-accum-string-str! a str2))
(string-copy! (accum-string-str a) start-pos s) (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 (accum-string-get! a config #:start-pos [start-pos 0])
(define s (substring (accum-string-str a) (define s (substring (accum-string-str a)

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

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require racket/private/check (require racket/private/check
racket/fixnum
racket/extflonum racket/extflonum
;; Call the host `string->number` function only ;; Call the host `string->number` function only
;; on valid fixnum, bignum, {single-,double-,ext}flonum ;; on valid fixnum, bignum, {single-,double-,ext}flonum
@ -66,16 +67,16 @@
#:in-complex [in-complex #f] ; #f, 'i, or '@ #:in-complex [in-complex #f] ; #f, 'i, or '@
convert-mode) convert-mode)
(cond (cond
[(= start end) [(fx= start end)
(fail convert-mode "no digits")] (fail convert-mode "no digits")]
[else [else
(define c (string-ref s start)) (define c (string-ref s start))
(cond (cond
;; `#e`, `#x`, etc. ;; `#e`, `#x`, etc.
[(char=? #\# c) [(char=? #\# c)
(define next (add1 start)) (define next (fx+ 1 start))
(cond (cond
[(= next end) [(fx= next end)
(fail convert-mode "no character after `#` indicator in `~.a`" s)] (fail convert-mode "no character after `#` indicator in `~.a`" s)]
[else [else
(define i (string-ref s next)) (define i (string-ref s next))
@ -85,7 +86,7 @@
[(or (exactness-set? exactness) in-complex) [(or (exactness-set? exactness) in-complex)
(fail convert-mode "misplaced exactness specification at `~.a`" (substring s start end))] (fail convert-mode "misplaced exactness specification at `~.a`" (substring s start end))]
[else [else
(do-string->number s (add1 next) end (do-string->number s (fx+ 1 next) end
radix #:radix-set? radix-set? radix #:radix-set? radix-set?
(if (or (char=? i #\e) (char=? i #\E)) 'exact 'inexact) (if (or (char=? i #\e) (char=? i #\E)) 'exact 'inexact)
(if (eq? convert-mode 'read) 'must-read convert-mode))])] (if (eq? convert-mode 'read) 'must-read convert-mode))])]
@ -100,7 +101,7 @@
[(#\o #\O) 8] [(#\o #\O) 8]
[(#\d #\D) 10] [(#\d #\D) 10]
[else 16])) [else 16]))
(do-string->number s (add1 next) end (do-string->number s (fx+ 1 next) end
radix #:radix-set? #t radix #:radix-set? #t
exactness exactness
(if (eq? convert-mode 'read) 'must-read convert-mode))])] (if (eq? convert-mode 'read) 'must-read convert-mode))])]
@ -119,13 +120,13 @@
;; +inf.0+...i, etc. ;; +inf.0+...i, etc.
[(and (char-sign? c) [(and (char-sign? c)
(not in-complex) (not in-complex)
((- end start) . > . 7) ((fx- end start) . fx> . 7)
(char=? #\i (string-ref s (sub1 end))) (char=? #\i (string-ref s (fx- end 1)))
(char-sign? (string-ref s 6)) (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) (lambda (v)
(read-for-special-compound s (+ start 6) (sub1 end) (read-for-special-compound s (fx+ start 6) (fx- end 1)
radix radix
exactness exactness
convert-mode convert-mode
@ -134,18 +135,18 @@
(make-rectangular v v2))))] (make-rectangular v v2))))]
;; ...+inf.0i, etc. ;; ...+inf.0i, etc.
[(and (not in-complex) [(and (not in-complex)
((- end start) . >= . 7) ; allow `+inf.0i` ((fx- end start) . fx>= . 7) ; allow `+inf.0i`
(char=? #\i (string-ref s (sub1 end))) (char=? #\i (string-ref s (fx- end 1)))
(char-sign? (string-ref s (- end 7))) (char-sign? (string-ref s (fx- end 7)))
(read-special-number s (- end 7) (sub1 end) convert-mode)) (read-special-number s (fx- end 7) (fx- end 1) convert-mode))
=> =>
(lambda (v2) (lambda (v2)
(cond (cond
[(and (= start (- end 7)) [(and (fx= start (fx- end 7))
(not (extflonum? v2))) (not (extflonum? v2)))
(make-rectangular 0 v2)] (make-rectangular 0 v2)]
[else [else
(read-for-special-compound s start (- end 7) (read-for-special-compound s start (fx- end 7)
radix radix
exactness exactness
convert-mode convert-mode
@ -156,12 +157,12 @@
;; +inf.0@..., etc. ;; +inf.0@..., etc.
[(and (char-sign? c) [(and (char-sign? c)
(not in-complex) (not in-complex)
((- end start) . > . 7) ((fx- end start) . fx> . 7)
(char=? #\@ (string-ref s (+ start 6))) (char=? #\@ (string-ref s (fx+ start 6)))
(read-special-number s start (+ start 6) convert-mode)) (read-special-number s start (fx+ start 6) convert-mode))
=> =>
(lambda (v) (lambda (v)
(read-for-special-compound s (+ start 7) end (read-for-special-compound s (fx+ start 7) end
radix radix
exactness exactness
convert-mode convert-mode
@ -170,12 +171,12 @@
(make-polar v v2))))] (make-polar v v2))))]
;; ...@+inf.0, etc. ;; ...@+inf.0, etc.
[(and (not in-complex) [(and (not in-complex)
((- end start) . > . 7) ((fx- end start) . fx> . 7)
(char=? #\@ (string-ref s (- end 7))) (char=? #\@ (string-ref s (fx- end 7)))
(read-special-number s (- end 6) end convert-mode)) (read-special-number s (fx- end 6) end convert-mode))
=> =>
(lambda (v2) (lambda (v2)
(read-for-special-compound s start (- end 7) (read-for-special-compound s start (fx- end 7)
radix radix
exactness exactness
convert-mode convert-mode
@ -207,7 +208,7 @@
[sign-pos #f] [dot-pos #f] [slash-pos #f] [exp-pos #f] [sign-pos #f] [dot-pos #f] [slash-pos #f] [exp-pos #f]
[must-i? #f]) [must-i? #f])
(cond (cond
[(= i end) [(fx= i end)
;; We've finished looking, so dispatch on the kind of number parsing ;; We've finished looking, so dispatch on the kind of number parsing
;; based on found `@`, etc. ;; based on found `@`, etc.
;; If we saw `@`, then we discarded other positions at that point. ;; If we saw `@`, then we discarded other positions at that point.
@ -223,18 +224,18 @@
[(and must-i? (not i-pos)) [(and must-i? (not i-pos))
(fail convert-mode "too many signs in `~.a`" (substring s start end))] (fail convert-mode "too many signs in `~.a`" (substring s start end))]
[(and sign-pos [(and sign-pos
(or (and dot-pos (dot-pos . < . sign-pos)) (or (and dot-pos (dot-pos . fx< . sign-pos))
(and slash-pos (slash-pos . < . sign-pos)))) (and slash-pos (slash-pos . fx< . sign-pos))))
(fail convert-mode "misplaced sign in `~.a`" (substring s start end))] (fail convert-mode "misplaced sign in `~.a`" (substring s start end))]
[i-pos [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 i-pos sign-pos
radix #:radix-set? radix-set? radix #:radix-set? radix-set?
exactness exactness
#:in-complex 'i #:in-complex 'i
convert-mode)] convert-mode)]
[@-pos [@-pos
(string->complex-number s start @-pos (add1 @-pos) end (string->complex-number s start @-pos (fx+ 1 @-pos) end
i-pos sign-pos i-pos sign-pos
radix #:radix-set? radix-set? radix #:radix-set? radix-set?
exactness exactness
@ -251,11 +252,11 @@
(define c (string-ref s i)) (define c (string-ref s i))
(cond (cond
[(digit? c radix) [(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 sign-pos dot-pos slash-pos exp-pos
must-i?)] must-i?)]
[(char=? c #\#) ; treat like a digit [(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 sign-pos dot-pos slash-pos exp-pos
must-i?)] must-i?)]
[(char-sign? c) [(char-sign? c)
@ -263,30 +264,30 @@
[(and sign-pos must-i?) [(and sign-pos must-i?)
(fail convert-mode "too many signs in `~.a`" (substring s start end))] (fail convert-mode "too many signs in `~.a`" (substring s start end))]
[else [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 i dot-pos slash-pos #f
;; must be complex if sign isn't at start ;; 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 #\.) [(char=? c #\.)
(cond (cond
[(or (and exp-pos (or (not sign-pos) (exp-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 . > . sign-pos)))) (and dot-pos (or (not sign-pos) (dot-pos . fx> . sign-pos))))
(fail convert-mode "misplaced `.` in `~.a`" (substring s start end))] (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))] (fail convert-mode "decimal points and fractions annot be mixed `~.a`" (substring s start end))]
[else [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 sign-pos i #f #f
must-i?)])] must-i?)])]
[(char=? c #\/) [(char=? c #\/)
(cond (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))] (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))) [(or (and exp-pos (or (not sign-pos) (exp-pos . fx> . sign-pos)))
(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 "misplaced `/` in `~.a`" (substring s start end))] (fail convert-mode "misplaced `/` in `~.a`" (substring s start end))]
[else [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 sign-pos #f i #f
must-i?)])] must-i?)])]
[(or (char=? c #\e) (char=? c #\E) [(or (char=? c #\e) (char=? c #\E)
@ -299,13 +300,13 @@
[exp-pos [exp-pos
(fail convert-mode "misplaced `~a` in `~.a`" c (substring s start end))] (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` ;; Don't count a sign in something like 1e+2 as `sign-pos`
[(and ((add1 i) . < . end) [(and ((fx+ 1 i) . fx< . end)
(char-sign? (string-ref s (add1 i)))) (char-sign? (string-ref s (fx+ 1 i))))
(loop (+ i 2) any-digits? any-hashes? i-pos @-pos (loop (fx+ i 2) any-digits? any-hashes? i-pos @-pos
sign-pos dot-pos slash-pos (or exp-pos i) sign-pos dot-pos slash-pos (or exp-pos i)
must-i?)] must-i?)]
[else [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) sign-pos dot-pos slash-pos (or exp-pos i)
must-i?)])] must-i?)])]
[(char=? c #\@) [(char=? c #\@)
@ -314,12 +315,12 @@
(fail convert-mode "cannot mix `@` and `i` in `~.a`" (substring s start end))] (fail convert-mode "cannot mix `@` and `i` in `~.a`" (substring s start end))]
[(or @-pos (eq? in-complex '@)) [(or @-pos (eq? in-complex '@))
(fail convert-mode "too many `@`s in `~.a`" (substring s start end))] (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))] (fail convert-mode "`@` cannot be at start in `~.a`" (substring s start end))]
[must-i? [must-i?
(fail convert-mode "too many signs in `~.a`" (substring s start end))] (fail convert-mode "too many signs in `~.a`" (substring s start end))]
[else [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 #f #f #f #f
must-i?)])] must-i?)])]
[(and (or (char=? c #\i) (char=? c #\I)) [(and (or (char=? c #\i) (char=? c #\I))
@ -327,10 +328,10 @@
(cond (cond
[(or @-pos (eq? in-complex '@)) [(or @-pos (eq? in-complex '@))
(fail convert-mode "cannot mix `@` and `i` in `~.a`" (substring s start end))] (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))] (fail convert-mode "`i` must be at the end in `~.a`" (substring s start end))]
[else [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 sign-pos #f #f #f
#f)])] #f)])]
[else [else
@ -350,7 +351,7 @@
#:in-complex in-complex ; 'i or '@ #:in-complex in-complex ; 'i or '@
convert-mode) convert-mode)
(define v1 (cond (define v1 (cond
[(= start1 end1) [(fx= start1 end1)
;; The input was "[+-]<num>i", so the real part ;; The input was "[+-]<num>i", so the real part
;; is implicitly "0" ;; is implicitly "0"
(if (eq? exactness 'inexact) (if (eq? exactness 'inexact)
@ -364,7 +365,7 @@
convert-mode)])) convert-mode)]))
(define v2 (cond (define v2 (cond
[(and (eq? in-complex 'i) [(and (eq? in-complex 'i)
(= (- end2 start2) 1)) (fx= (fx- end2 start2) 1))
;; The input ends "[+-]i", so the number is implicitly ;; The input ends "[+-]i", so the number is implicitly
;; "1" ;; "1"
(define neg? (char=? (string-ref s start2) #\-)) (define neg? (char=? (string-ref s start2) #\-))
@ -420,22 +421,22 @@
(not (eq? convert-mode 'number-or-false)) (not (eq? convert-mode 'number-or-false))
(not (extfl-mark?))) (not (extfl-mark?)))
(not (and any-hashes? (hashes? s start end))))) (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 (cond
[(= (- end start) (+ (if dot-pos 1 0) (if exp-pos 1 0) (if has-sign? 1 0))) [(fx= (fx- end start) (fx+ (if dot-pos 1 0) (if exp-pos 1 0) (if has-sign? 1 0)))
(if (= end start) (if (fx= end start)
(fail convert-mode "missing digits") (fail convert-mode "missing digits")
(fail convert-mode "missing digits in `~.a`" (substring s start end)))] (fail convert-mode "missing digits in `~.a`" (substring s start end)))]
[simple? [simple?
(cond (cond
[(and exp-pos (= (- exp-pos start) [(and exp-pos (fx= (fx- exp-pos start)
(+ (if (and dot-pos (< dot-pos exp-pos)) 1 0) (fx+ (if (and dot-pos (fx< dot-pos exp-pos)) 1 0)
(if has-sign? 1 0)))) (if has-sign? 1 0))))
(fail convert-mode "missing digits before exponent marker in `~.a`" (substring s start end))] (fail convert-mode "missing digits before exponent marker in `~.a`" (substring s start end))]
[(and exp-pos [(and exp-pos
(or (= exp-pos (sub1 end)) (or (fx= exp-pos (fx- end 1))
(and (= exp-pos (- end 2)) (and (fx= exp-pos (fx- end 2))
(char-sign? (string-ref s (sub1 end)))))) (char-sign? (string-ref s (fx- end 1))))))
(fail convert-mode "missing digits after exponent marker in `~.a`" (substring s start end))] (fail convert-mode "missing digits after exponent marker in `~.a`" (substring s start end))]
[else [else
(define n (host:string->number (maybe-substring s start end) radix (define n (host:string->number (maybe-substring s start end) radix
@ -465,7 +466,7 @@
radix radix
'exact 'exact
convert-mode)) 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 radix
convert-mode)) convert-mode))
(define (real->precision-inexact r) (define (real->precision-inexact r)
@ -524,7 +525,7 @@
radix radix
'exact 'exact
convert-mode)) 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 #f #f #f
any-hashes? any-hashes?
radix radix
@ -542,7 +543,7 @@
[(string? d-v) d-v] [(string? d-v) d-v]
[(eqv? d-v 0) [(eqv? d-v 0)
(cond (cond
[(get-inexact? (add1 slash-pos)) [(get-inexact? (fx+ 1 slash-pos))
(if (negative? n-v) (if (negative? n-v)
-inf.0 -inf.0
+inf.0)] +inf.0)]
@ -571,13 +572,13 @@
exactness exactness
convert-mode) convert-mode)
(define get-exact? (or (eq? exactness 'exact) (eq? exactness 'decimal-as-exact))) (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)))) (define new-str (make-string (fx- end start (if (and dot-pos get-exact?) 1 0))))
(let loop ([i (sub1 end)] [j (sub1 (string-length new-str))] [hashes-pos end]) (let loop ([i (fx- end 1)] [j (fx- (string-length new-str) 1)] [hashes-pos end])
(cond (cond
[(i . < . start) [(i . fx< . start)
;; Convert `new-str` to an integer and finish up ;; Convert `new-str` to an integer and finish up
(cond (cond
[(= hashes-pos start) [(fx= hashes-pos start)
(fail convert-mode "misplaced `#` in `~.a`" (substring s start end))] (fail convert-mode "misplaced `#` in `~.a`" (substring s start end))]
[else [else
(define n (host:string->number new-str radix)) (define n (host:string->number new-str radix))
@ -590,7 +591,7 @@
-0.0 -0.0
(exact->inexact n))] (exact->inexact n))]
[(and dot-pos get-exact?) [(and dot-pos get-exact?)
(/ n (expt 10 (- end dot-pos 1)))] (/ n (expt 10 (fx- end dot-pos 1)))]
[else n])])] [else n])])]
[else [else
(define c (string-ref s i)) (define c (string-ref s i))
@ -598,23 +599,23 @@
[(char=? c #\.) [(char=? c #\.)
(cond (cond
[get-exact? [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 [else
(string-set! new-str j 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))])]
[(or (char=? c #\-) (char=? c #\+)) [(or (char=? c #\-) (char=? c #\+))
(string-set! new-str j 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 #\#) [(char=? c #\#)
(cond (cond
[(= hashes-pos (add1 i)) [(fx= hashes-pos (fx+ 1 i))
(string-set! new-str j #\0) (string-set! new-str j #\0)
(loop (sub1 i) (sub1 j) i)] (loop (fx- i 1) (fx- j 1) i)]
[else [else
(fail convert-mode "misplaced `#` in `~.a`" (substring s start end))])] (fail convert-mode "misplaced `#` in `~.a`" (substring s start end))])]
[else [else
(string-set! new-str j c) (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 ;; Parse an integer that might have `#` and a leading `+` or `-`, but
;; no other non-digit characters ;; no other non-digit characters
@ -634,40 +635,40 @@
;; Try to read as `+inf.0`, etc. ;; Try to read as `+inf.0`, etc.
(define (read-special-number s start end convert-mode) (define (read-special-number s start end convert-mode)
(and (and
(= (- end start) 6) (fx= (fx- end start) 6)
(or (char=? (string-ref s start) #\+) (or (char=? (string-ref s start) #\+)
(char=? (string-ref s start) #\-)) (char=? (string-ref s start) #\-))
(or (or
(and (char=? (char-downcase (string-ref s (+ start 1))) #\i) (and (char=? (char-downcase (string-ref s (fx+ start 1))) #\i)
(char=? (char-downcase (string-ref s (+ start 2))) #\n) (char=? (char-downcase (string-ref s (fx+ start 2))) #\n)
(char=? (char-downcase (string-ref s (+ start 3))) #\f) (char=? (char-downcase (string-ref s (fx+ start 3))) #\f)
(char=? (char-downcase (string-ref s (+ start 4))) #\.) (char=? (char-downcase (string-ref s (fx+ start 4))) #\.)
(or (or
(and (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) #\+) (if (char=? (string-ref s start) #\+)
+inf.0 +inf.0
-inf.0)) -inf.0))
(and (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) #\+) (if (char=? (string-ref s start) #\+)
+inf.f +inf.f
-inf.f)) -inf.f))
(and (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)) (not (eq? convert-mode 'number-or-false))
(if (char=? (string-ref s start) #\+) (if (char=? (string-ref s start) #\+)
+inf.t +inf.t
-inf.t)))) -inf.t))))
(and (char=? (char-downcase (string-ref s (+ start 1))) #\n) (and (char=? (char-downcase (string-ref s (fx+ start 1))) #\n)
(char=? (char-downcase (string-ref s (+ start 2))) #\a) (char=? (char-downcase (string-ref s (fx+ start 2))) #\a)
(char=? (char-downcase (string-ref s (+ start 3))) #\n) (char=? (char-downcase (string-ref s (fx+ start 3))) #\n)
(char=? (char-downcase (string-ref s (+ start 4))) #\.) (char=? (char-downcase (string-ref s (fx+ start 4))) #\.)
(or (and (char=? (char-downcase (string-ref s (+ start 5))) #\0) (or (and (char=? (char-downcase (string-ref s (fx+ start 5))) #\0)
+nan.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) +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)) (not (eq? convert-mode 'number-or-false))
+nan.t)))))) +nan.t))))))
@ -709,7 +710,7 @@
(char=? c #\#))) (char=? c #\#)))
(define (replace-hashes s start end) (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)] (for ([c (in-string s start end)]
[i (in-naturals)]) [i (in-naturals)])
(if (char=? c #\#) (if (char=? c #\#)
@ -718,8 +719,8 @@
new-s) new-s)
(define (maybe-substring s start end) (define (maybe-substring s start end)
(if (and (= 0 start) (if (and (fx= 0 start)
(= end (string-length s))) (fx= end (string-length s)))
s s
(substring s start end))) (substring s start end)))
@ -731,15 +732,15 @@
(define (digit? c radix) (define (digit? c radix)
(define v (char->integer c)) (define v (char->integer c))
(or (and (v . >= . (char->integer #\0)) (or (and (v . fx>= . (char->integer #\0))
((- v (char->integer #\0)) . < . radix)) ((fx- v (char->integer #\0)) . fx< . radix))
(and (radix . > . 10) (and (radix . fx> . 10)
(or (and (or (and
(v . >= . (char->integer #\a)) (v . fx>= . (char->integer #\a))
((- v (- (char->integer #\a) 10)) . < . radix)) ((fx- v (fx- (char->integer #\a) 10)) . fx< . radix))
(and (and
(v . >= . (char->integer #\A)) (v . fx>= . (char->integer #\A))
((- v (- (char->integer #\A) 10)) . < . radix)))))) ((fx- v (fx- (char->integer #\A) 10)) . fx< . radix))))))
(define (fail-bad-number convert-mode s start end) (define (fail-bad-number convert-mode s start end)
(fail convert-mode "bad number `~.a`" (substring s start end))) (fail convert-mode "bad number `~.a`" (substring s start end)))

145
racket/src/io/port/pipe.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require "../common/check.rkt" (require racket/fixnum
"../common/check.rkt"
"../common/fixnum.rkt" "../common/fixnum.rkt"
"../host/thread.rkt" "../host/thread.rkt"
"port.rkt" "port.rkt"
@ -58,10 +59,10 @@
(define output-closed? #f) (define output-closed? #f)
(define (content-length) (define (content-length)
(if (start . <= . end) (if (start . fx<= . end)
(- end start) (fx- end start)
(+ end (- len start)))) (fx+ end (fx- len start))))
(define (input-empty?) (= start end)) (define (input-empty?) (fx= start end))
(define (output-full?) (define (output-full?)
(and limit (and limit
((content-length) . >= . (+ limit peeked-amt)))) ((content-length) . >= . (+ limit peeked-amt))))
@ -76,7 +77,7 @@
[() (or write-pos end)] [() (or write-pos end)]
[(pos) [(pos)
;; `pos` must be between `start` and `end` ;; `pos` must be between `start` and `end`
(if (= pos end) (if (fx= pos end)
(set! write-pos #f) (set! write-pos #f)
(set! write-pos pos))]) (set! write-pos pos))])
;; discard-all ;; discard-all
@ -169,10 +170,10 @@
[else [else
(define pos start) (define pos start)
(check-output-unblocking) (check-output-unblocking)
(unless (eqv? 0 peeked-amt) (unless (fx= 0 peeked-amt)
(set! peeked-amt (max 0 (sub1 peeked-amt)))) (set! peeked-amt (fxmax 0 (fx- peeked-amt 1))))
(define new-pos (add1 pos)) (define new-pos (fx+ pos 1))
(if (= new-pos len) (if (fx= new-pos len)
(set! start 0) (set! start 0)
(set! start new-pos)) (set! start new-pos))
(check-input-blocking) (check-input-blocking)
@ -191,19 +192,19 @@
(check-output-unblocking) (check-output-unblocking)
(begin0 (begin0
(cond (cond
[(start . < . end) [(start . fx< . end)
(define amt (min (- dest-end dest-start) (define amt (fxmin (fx- dest-end dest-start)
(- end start))) (fx- end start)))
(bytes-copy! dest-bstr dest-start bstr start (+ start amt)) (bytes-copy! dest-bstr dest-start bstr start (fx+ start amt))
(set! start (+ start amt)) (set! start (fx+ start amt))
(set! peeked-amt (max 0 (- peeked-amt amt))) (set! peeked-amt (fxmax 0 (fx- peeked-amt amt)))
amt] amt]
[else [else
(define amt (min (- dest-end dest-start) (define amt (fxmin (fx- dest-end dest-start)
(- len start))) (fx- len start)))
(bytes-copy! dest-bstr dest-start bstr start (+ start amt)) (bytes-copy! dest-bstr dest-start bstr start (fx+ start amt))
(set! start (modulo (+ start amt) len)) (set! start (modulo (fx+ start amt) len))
(set! peeked-amt (max 0 (- peeked-amt amt))) (set! peeked-amt (fxmax 0 (fx- peeked-amt amt)))
amt]) amt])
(check-input-blocking) (check-input-blocking)
(progress!))])) (progress!))]))
@ -240,18 +241,18 @@
(lambda (v) 0)))) (lambda (v) 0))))
evt])] evt])]
[else [else
(define peek-start (modulo (+ start skip) len)) (define peek-start (fxmodulo (fx+ start skip) len))
(cond (cond
[(peek-start . < . end) [(peek-start . fx< . end)
(define amt (min (- dest-end dest-start) (define amt (fxmin (fx- dest-end dest-start)
(- end peek-start))) (fx- end peek-start)))
(bytes-copy! dest-bstr dest-start bstr peek-start (+ peek-start amt)) (bytes-copy! dest-bstr dest-start bstr peek-start (fx+ peek-start amt))
(peeked! (+ skip amt)) (peeked! (+ skip amt))
amt] amt]
[else [else
(define amt (min (- dest-end dest-start) (define amt (fxmin (fx- dest-end dest-start)
(- len peek-start))) (fx- len peek-start)))
(bytes-copy! dest-bstr dest-start bstr peek-start (+ peek-start amt)) (bytes-copy! dest-bstr dest-start bstr peek-start (fx+ peek-start amt))
(peeked! (+ skip amt)) (peeked! (+ skip amt))
amt])])) amt])]))
@ -259,7 +260,7 @@
(lambda (work-done!) (lambda (work-done!)
(assert-atomic) (assert-atomic)
(or output-closed? (or output-closed?
(not (zero? (content-length))))) (not (fx= 0 (content-length)))))
#:close #:close
(lambda () (lambda ()
@ -294,20 +295,20 @@
(lambda () (lambda ()
(let ([amt (min amt (content-length))]) (let ([amt (min amt (content-length))])
(cond (cond
[(zero? amt) [(fx= 0 amt)
;; There was nothing to commit; claim success for 0 bytes ;; There was nothing to commit; claim success for 0 bytes
(finish #"")] (finish #"")]
[else [else
(define dest-bstr (make-bytes amt)) (define dest-bstr (make-bytes amt))
(cond (cond
[(start . < . end) [(start . fx< . end)
(bytes-copy! dest-bstr 0 bstr start (+ start amt))] (bytes-copy! dest-bstr 0 bstr start (fx+ start amt))]
[else [else
(define amt1 (min (- len start) amt)) (define amt1 (fxmin (fx- len start) amt))
(bytes-copy! dest-bstr 0 bstr start (+ start amt1)) (bytes-copy! dest-bstr 0 bstr start (fx+ start amt1))
(when (amt1 . < . amt) (when (amt1 . fx< . amt)
(bytes-copy! dest-bstr amt1 bstr 0 (- amt amt1)))]) (bytes-copy! dest-bstr amt1 bstr 0 (fx- amt amt1)))])
(set! start (modulo (+ start amt) len)) (set! start (fxmodulo (fx+ start amt) len))
(progress!) (progress!)
(check-input-blocking) (check-input-blocking)
(finish dest-bstr)]))))])))) (finish dest-bstr)]))))]))))
@ -325,23 +326,23 @@
(lambda (src-bstr src-start src-end nonblock? enable-break? copy?) (lambda (src-bstr src-start src-end nonblock? enable-break? copy?)
(assert-atomic) (assert-atomic)
(let try-again () (let try-again ()
(define top-pos (if (zero? start) (define top-pos (if (fx= start 0)
(sub1 len) (fx- len 1)
len)) len))
(define (maybe-grow) (define (maybe-grow)
(cond (cond
[(or (not limit) [(or (not limit)
((+ limit peeked-amt) . > . (sub1 len))) ((+ limit peeked-amt) . > . (fx- len 1)))
;; grow pipe size ;; grow pipe size
(define new-bstr (make-bytes (min+1 (and limit (+ limit peeked-amt)) (* len 2)))) (define new-bstr (make-bytes (min+1 (and limit (+ limit peeked-amt)) (* len 2))))
(cond (cond
[(zero? start) [(fx= 0 start)
(bytes-copy! new-bstr 0 bstr 0 (sub1 len))] (bytes-copy! new-bstr 0 bstr 0 (fx- len 1))]
[else [else
(bytes-copy! new-bstr 0 bstr start len) (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! start 0)
(set! end (sub1 len))]) (set! end (fx- len 1))])
(set! bstr new-bstr) (set! bstr new-bstr)
(set! len (bytes-length new-bstr)) (set! len (bytes-length new-bstr))
(try-again)] (try-again)]
@ -353,59 +354,59 @@
(min amt (- (+ limit peeked-amt) (content-length))) (min amt (- (+ limit peeked-amt) (content-length)))
amt)) amt))
(cond (cond
[(= src-start src-end) ;; => flush [(fx= src-start src-end) ;; => flush
0] 0]
[write-pos ; set by `file-position` on a bytes port [write-pos ; set by `file-position` on a bytes port
(define amt (apply-limit (min (- end write-pos) (define amt (apply-limit (fxmin (fx- end write-pos)
(- src-end src-start)))) (fx- src-end src-start))))
(cond (cond
[(zero? amt) (pipe-is-full)] [(fx= amt 0) (pipe-is-full)]
[else [else
(check-input-unblocking) (check-input-unblocking)
(bytes-copy! bstr write-pos src-bstr src-start (+ src-start amt)) (bytes-copy! bstr write-pos src-bstr src-start (fx+ src-start amt))
(let ([new-write-pos (+ write-pos amt)]) (let ([new-write-pos (fx+ write-pos amt)])
(if (= new-write-pos end) (if (fx= new-write-pos end)
(set! write-pos #f) ; back to normal mode (set! write-pos #f) ; back to normal mode
(set! write-pos new-write-pos))) (set! write-pos new-write-pos)))
(check-output-blocking) (check-output-blocking)
amt])] amt])]
[(and (end . >= . start) [(and (end . fx>= . start)
(end . < . top-pos)) (end . fx< . top-pos))
(define amt (apply-limit (min (- top-pos end) (define amt (apply-limit (fxmin (fx- top-pos end)
(- src-end src-start)))) (fx- src-end src-start))))
(cond (cond
[(zero? amt) (pipe-is-full)] [(fx= amt 0) (pipe-is-full)]
[else [else
(check-input-unblocking) (check-input-unblocking)
(bytes-copy! bstr end src-bstr src-start (+ src-start amt)) (bytes-copy! bstr end src-bstr src-start (fx+ src-start amt))
(let ([new-end (+ end amt)]) (let ([new-end (fx+ end amt)])
(set! end (if (= new-end len) 0 new-end))) (set! end (if (fx= new-end len) 0 new-end)))
(check-output-blocking) (check-output-blocking)
amt])] amt])]
[(= end top-pos) [(fx= end top-pos)
(cond (cond
[(zero? start) [(fx= start 0)
(maybe-grow)] (maybe-grow)]
[else [else
(define amt (min (sub1 start) (define amt (fxmin (fx- start 1)
(- src-end src-start))) (fx- src-end src-start)))
(cond (cond
[(zero? amt) (pipe-is-full)] [(fx= amt 0) (pipe-is-full)]
[else [else
(check-input-unblocking) (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) (set! end amt)
(check-output-blocking) (check-output-blocking)
amt])])] amt])])]
[(end . < . (sub1 start)) [(end . fx< . (fx- start 1))
(define amt (apply-limit (min (- (sub1 start) end) (define amt (apply-limit (fxmin (fx- (fx- start 1) end)
(- src-end src-start)))) (fx- src-end src-start))))
(cond (cond
[(zero? amt) (pipe-is-full)] [(fx= amt 0) (pipe-is-full)]
[else [else
(check-input-unblocking) (check-input-unblocking)
(bytes-copy! bstr end src-bstr src-start (+ src-start amt)) (bytes-copy! bstr end src-bstr src-start (fx+ src-start amt))
(set! end (+ end amt)) (set! end (fx+ end amt))
(check-output-blocking) (check-output-blocking)
amt])] amt])]
[else [else

87
racket/src/io/string/utf-8-decode.rkt
View File

@ -1,4 +1,5 @@
#lang racket/base #lang racket/base
(require racket/fixnum)
(provide utf-8-decode! (provide utf-8-decode!
utf-8-max-aborts-amt utf-8-max-aborts-amt
@ -42,7 +43,7 @@
#:state [state #f]) ; state that was returned in place of a previous 'aborts result #:state [state #f]) ; state that was returned in place of a previous 'aborts result
(define base-i ; start of current encoding sequence (define base-i ; start of current encoding sequence
(if state (if state
(- in-start (utf-8-state-pending-amt state)) (fx- in-start (utf-8-state-pending-amt state))
in-start)) in-start))
(define accum ; accumulated value for encoding (define accum ; accumulated value for encoding
(if state (if state
@ -61,29 +62,29 @@
(cond (cond
[error-ch [error-ch
(when out-str (string-set! out-str j error-ch)) (when out-str (string-set! out-str j error-ch))
(define next-j (add1 j)) (define next-j (fx+ j 1))
(define next-i (add1 base-i)) (define next-i (fx+ base-i 1))
(cond (cond
[(and out-end (= next-j out-end)) [(and out-end (fx= next-j out-end))
(values (- next-i in-start) (values (fx- next-i in-start)
(- next-j out-start) (fx- next-j out-start)
'continues)] 'continues)]
[else [else
(loop next-i next-j next-i 0 0)])] (loop next-i next-j next-i 0 0)])]
[else [else
(values (- base-i in-start) (values (fx- base-i in-start)
(- j out-start) (fx- j out-start)
'error)])) 'error)]))
;; Shared handling for decoding success: ;; Shared handling for decoding success:
(define (continue) (define (continue)
(define next-j (add1 j)) (define next-j (fx+ j 1))
(define next-i (add1 i)) (define next-i (fx+ i 1))
(cond (cond
[(and out-end (= next-j out-end)) [(and out-end (fx= next-j out-end))
(values (- next-i in-start) (values (fx- next-i in-start)
(- next-j out-start) (fx- next-j out-start)
(if (= next-i in-end) (if (fx= next-i in-end)
'complete 'complete
'continues))] 'continues))]
[else [else
@ -91,24 +92,24 @@
;; Dispatch on byte: ;; Dispatch on byte:
(cond (cond
[(= i in-end) [(fx= i in-end)
;; End of input ;; End of input
(cond (cond
[(zero? remaining) [(fx= remaining 0)
(values (- base-i in-start) (values (fx- base-i in-start)
(- j out-start) (fx- j out-start)
'complete)] 'complete)]
[(eq? abort-mode 'error) [(eq? abort-mode 'error)
(encoding-failure)] (encoding-failure)]
[(eq? abort-mode 'state) [(eq? abort-mode 'state)
(values (- i in-start) ; all bytes used (values (fx- i in-start) ; all bytes used
(- j out-start) (fx- j out-start)
(utf-8-state accum remaining (- i base-i)))] (utf-8-state accum remaining (fx- i base-i)))]
[else [else
(values (- base-i in-start) (values (fx- base-i in-start)
(- j out-start) (fx- j out-start)
'aborts)])] 'aborts)])]
[(i . < . in-start) [(i . fx< . in-start)
;; Happens only if we resume decoding with some state ;; Happens only if we resume decoding with some state
;; and hit a decoding error; treat the byte as another ;; and hit a decoding error; treat the byte as another
;; encoding error ;; encoding error
@ -116,9 +117,9 @@
[else [else
(define b (bytes-ref in-bstr i)) (define b (bytes-ref in-bstr i))
(cond (cond
[(b . < . 128) [(b . fx< . 128)
(cond (cond
[(zero? remaining) [(fx= remaining 0)
;; Found ASCII ;; Found ASCII
(when out-str (string-set! out-str j (integer->char b))) (when out-str (string-set! out-str j (integer->char b)))
(continue)] (continue)]
@ -129,14 +130,14 @@
[else [else
;; Encoding... ;; Encoding...
(cond (cond
[(= #b10000000 (bitwise-and b #b11000000)) [(fx= #b10000000 (fxand b #b11000000))
;; A continuation byte ;; A continuation byte
(cond (cond
[(zero? remaining) [(fx= remaining 0)
;; We weren't continuing ;; We weren't continuing
(encoding-failure)] (encoding-failure)]
[else [else
(define next (bitwise-and b #b00111111)) (define next (fxand b #b00111111))
(define next-accum (bitwise-ior (arithmetic-shift accum 6) next)) (define next-accum (bitwise-ior (arithmetic-shift accum 6) next))
(cond (cond
[(= 1 remaining) [(= 1 remaining)
@ -150,38 +151,38 @@
[else [else
;; Not a valid character ;; Not a valid character
(encoding-failure)])] (encoding-failure)])]
[(and (= 2 remaining) [(and (fx= 2 remaining)
(next-accum . <= . #b11111)) (next-accum . <= . #b11111))
;; A shorter byte sequence would work, so this is an ;; A shorter byte sequence would work, so this is an
;; encoding mistae. ;; encoding mistae.
(encoding-failure)] (encoding-failure)]
[(and (= 3 remaining) [(and (fx= 3 remaining)
(next-accum . <= . #b1111)) (next-accum . <= . #b1111))
;; A shorter byte sequence would work ;; A shorter byte sequence would work
(encoding-failure)] (encoding-failure)]
[else [else
;; Continue an encoding. ;; Continue an encoding.
(loop (add1 i) j base-i next-accum (sub1 remaining))])])] (loop (fx+ i 1) j base-i next-accum (fx- remaining 1))])])]
[(not (zero? remaining)) [(not (fx= remaining 0))
;; Trying to start a new encoding while one is in ;; Trying to start a new encoding while one is in
;; progress ;; progress
(encoding-failure)] (encoding-failure)]
[(= #b11000000 (bitwise-and b #b11100000)) [(fx= #b11000000 (fxand b #b11100000))
;; Start a two-byte encoding ;; 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, ;; If `accum` is zero, that's an encoding mistake,
;; because a shorted byte sequence would work. ;; because a shorted byte sequence would work.
(cond (cond
[(zero? accum) (encoding-failure)] [(fx= accum 0) (encoding-failure)]
[else (loop (add1 i) j i accum 1)])] [else (loop (fx+ i 1) j i accum 1)])]
[(= #b11100000 (bitwise-and b #b11110000)) [(fx= #b11100000 (fxand b #b11110000))
;; Start a three-byte encoding ;; Start a three-byte encoding
(define accum (bitwise-and b #b1111)) (define accum (fxand b #b1111))
(loop (add1 i) j i accum 2)] (loop (fx+ i 1) j i accum 2)]
[(= #b11110000 (bitwise-and b #b11111000)) [(fx= #b11110000 (fxand b #b11111000))
;; Start a four-byte encoding ;; Start a four-byte encoding
(define accum (bitwise-and b #b111)) (define accum (fxand b #b111))
(loop (add1 i) j i accum 3)] (loop (fx+ i 1) j i accum 3)]
[else [else
;; Five- or six-byte encodings don't produce valid ;; Five- or six-byte encodings don't produce valid
;; characters ;; characters

44
racket/src/io/string/utf-8-encode.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base #lang racket/base
(require racket/fixnum)
(provide utf-8-encode! (provide utf-8-encode!
utf-8-encode-dispatch) utf-8-encode-dispatch)
;; Returns (values chars-used bytes-written (or/c 'complete 'continues)) ;; Returns (values chars-used bytes-written (or/c 'complete 'continues))
@ -12,11 +12,11 @@
;; Iterate through the given string ;; Iterate through the given string
(let loop ([i in-start] [j out-start]) (let loop ([i in-start] [j out-start])
(cond (cond
[(= i in-end) [(fx= i in-end)
(values (- in-end in-start) (- j out-start) 'complete)] (values (fx- in-end in-start) (fx- j out-start) 'complete)]
[else [else
(define b (char->integer (string-ref in-str i))) (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 (utf-8-encode-dispatch b
in-start i in-start i
out-bstr out-start out-end j out-bstr out-start out-end j
@ -30,40 +30,40 @@
[(b . <= . #x7F) [(b . <= . #x7F)
(cond (cond
[(and out-end (= j out-end)) [(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 [else
(when out-bstr (bytes-set! out-bstr j b)) (when out-bstr (bytes-set! out-bstr j b))
(continue (add1 j))])] (continue (fx+ j 1))])]
[(b . <= . #x7FF) [(b . <= . #x7FF)
(cond (cond
[(and out-end ((add1 j) . >= . out-end)) [(and out-end ((fx+ j 1) . fx>= . out-end))
(values (- i in-start) (- j out-start) 'continues)] (values (fx- i in-start) (fx- j out-start) 'continues)]
[else [else
(when out-bstr (when out-bstr
(bytes-set! out-bstr j (bitwise-ior #b11000000 (arithmetic-shift b -6))) (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)))) (bytes-set! out-bstr (add1 j) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
(continue (+ j 2))])] (continue (+ j 2))])]
[(b . <= . #xFFFF) [(b . fx<= . #xFFFF)
(cond (cond
[(and out-end ((+ j 2) . >= . out-end)) [(and out-end ((fx+ j 2) . fx>= . out-end))
(values (- i in-start) (- j out-start) 'continues)] (values (fx- i in-start) (fx- j out-start) 'continues)]
[else [else
(when out-bstr (when out-bstr
(bytes-set! out-bstr j (bitwise-ior #b11100000 (arithmetic-shift b -12))) (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))) #b111111)))
(bytes-set! out-bstr (+ j 2) (bitwise-ior #b10000000 (bitwise-and b #b111111)))) (bytes-set! out-bstr (fx+ j 2) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
(continue (+ j 3))])] (continue (fx+ j 3))])]
[else [else
(cond (cond
[(and out-end ((+ j 3) . >= . out-end)) [(and out-end ((fx+ j 3) . fx>= . out-end))
(values (- i in-start) (- j out-start) 'continues)] (values (fx- i in-start) (fx- j out-start) 'continues)]
[else [else
(when out-bstr (when out-bstr
(bytes-set! out-bstr j (bitwise-ior #b11110000 (arithmetic-shift b -18))) (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) (bytes-set! out-bstr (fx+ j 1) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -12)
#b111111))) #b111111)))
(bytes-set! out-bstr (+ j 2) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6) (bytes-set! out-bstr (fx+ j 2) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6)
#b111111))) #b111111)))
(bytes-set! out-bstr (+ j 3) (bitwise-ior #b10000000 (bitwise-and b #b111111)))) (bytes-set! out-bstr (fx+ j 3) (bitwise-ior #b10000000 (bitwise-and b #b111111))))
(continue (+ j 4))])])) (continue (fx+ j 4))])]))

219
racket/src/racket/src/startup.inc
View File

@ -49416,12 +49416,12 @@ static const char *startup_source =
"(let-values(((pos_0)(accum-string-pos a_0)))" "(let-values(((pos_0)(accum-string-pos a_0)))"
"(let-values(((str_0)(accum-string-str a_0)))" "(let-values(((str_0)(accum-string-str a_0)))"
"(let-values(((str2_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() str_0)"
"(let-values()" "(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-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(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(set-accum-string-count!)(lambda(a_0 pos_0)(begin(set-accum-string-pos! a_0 pos_0))))"
"(define-values" "(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(((s_0)(convert_0(substring str_0 start-pos_0(accum-string-pos a_0)))))"
"(let-values(((len_0)(string-length s_0)))" "(let-values(((len_0)(string-length s_0)))"
"(begin" "(begin"
"(if(<(+ len_0 start-pos_0)(string-length str_0))" "(if(fx<(fx+ len_0 start-pos_0)(string-length str_0))"
"(void)" "(void)"
"(let-values()" "(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)))))" "(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)" "(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" "(define-values"
"(accum-string-get!6.1)" "(accum-string-get!6.1)"
"(lambda(start-pos2_0 a4_0 config5_0)" "(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(((in-complex_0) in-complex8_0))"
"(let-values(((convert-mode_0) convert-mode16_0))" "(let-values(((convert-mode_0) convert-mode16_0))"
"(let-values()" "(let-values()"
"(if(= start_0 end_0)" "(if(fx= start_0 end_0)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
" (let-values () (format \"no digits\"))" " (let-values () (format \"no digits\"))"
@ -50171,8 +50171,8 @@ static const char *startup_source =
"(let-values(((c_0)(string-ref s_0 start_0)))" "(let-values(((c_0)(string-ref s_0 start_0)))"
"(if(char=? '#\\# c_0)" "(if(char=? '#\\# c_0)"
"(let-values()" "(let-values()"
"(let-values(((next_0)(add1 start_0)))" "(let-values(((next_0)(fx+ 1 start_0)))"
"(if(= next_0 end_0)" "(if(fx= next_0 end_0)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
" (let-values () (format \"no character after `#` indicator in `~.a`\" s_0))" " (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() #f)))"
"(let-values()" "(let-values()"
"(let-values(((s73_0) s_0)" "(let-values(((s73_0) s_0)"
"((temp74_0)(add1 next_0))" "((temp74_0)(fx+ 1 next_0))"
"((end75_0) end_0)" "((end75_0) end_0)"
"((radix76_0) radix_0)" "((radix76_0) radix_0)"
"((radix-set?77_0) radix-set?_0)" "((radix-set?77_0) radix-set?_0)"
@ -50318,7 +50318,7 @@ static const char *startup_source =
"(let-values() 10)" "(let-values() 10)"
"(let-values() 16)))))))" "(let-values() 16)))))))"
"(let-values(((s80_0) s_0)" "(let-values(((s80_0) s_0)"
"((temp81_0)(add1 next_0))" "((temp81_0)(fx+ 1 next_0))"
"((end82_0) end_0)" "((end82_0) end_0)"
"((radix83_0) radix_1)" "((radix83_0) radix_1)"
"((temp84_0) #t)" "((temp84_0) #t)"
@ -50352,13 +50352,13 @@ static const char *startup_source =
"(let-values(((c2_0)" "(let-values(((c2_0)"
"(if(char-sign? c_0)" "(if(char-sign? c_0)"
"(if(not in-complex_0)" "(if(not in-complex_0)"
"(if(>(- end_0 start_0) 7)" "(if(fx>(fx- end_0 start_0) 7)"
"(if(char=? '#\\i(string-ref s_0(sub1 end_0)))" "(if(char=? '#\\i(string-ref s_0(fx- end_0 1)))"
"(if(char-sign?(string-ref s_0 6))" "(if(char-sign?(string-ref s_0 6))"
"(read-special-number" "(read-special-number"
" s_0" " s_0"
" start_0" " start_0"
"(+ start_0 6)" "(fx+ start_0 6)"
" convert-mode_0)" " convert-mode_0)"
" #f)" " #f)"
" #f)" " #f)"
@ -50368,8 +50368,8 @@ static const char *startup_source =
"(if c2_0" "(if c2_0"
"((lambda(v_0)" "((lambda(v_0)"
"(let-values(((s87_0) s_0)" "(let-values(((s87_0) s_0)"
"((temp88_0)(+ start_0 6))" "((temp88_0)(fx+ start_0 6))"
"((temp89_0)(sub1 end_0))" "((temp89_0)(fx- end_0 1))"
"((radix90_0) radix_0)" "((radix90_0) radix_0)"
"((exactness91_0) exactness_0)" "((exactness91_0) exactness_0)"
"((convert-mode92_0) convert-mode_0)" "((convert-mode92_0) convert-mode_0)"
@ -50392,13 +50392,13 @@ static const char *startup_source =
" c2_0)" " c2_0)"
"(let-values(((c3_0)" "(let-values(((c3_0)"
"(if(not in-complex_0)" "(if(not in-complex_0)"
"(if(>=(- end_0 start_0) 7)" "(if(fx>=(fx- end_0 start_0) 7)"
"(if(char=? '#\\i(string-ref s_0(sub1 end_0)))" "(if(char=? '#\\i(string-ref s_0(fx- end_0 1)))"
"(if(char-sign?(string-ref s_0(- end_0 7)))" "(if(char-sign?(string-ref s_0(fx- end_0 7)))"
"(read-special-number" "(read-special-number"
" s_0" " s_0"
"(- end_0 7)" "(fx- end_0 7)"
"(sub1 end_0)" "(fx- end_0 1)"
" convert-mode_0)" " convert-mode_0)"
" #f)" " #f)"
" #f)" " #f)"
@ -50406,12 +50406,12 @@ static const char *startup_source =
" #f)))" " #f)))"
"(if c3_0" "(if c3_0"
"((lambda(v2_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()(make-rectangular 0 v2_0))"
"(let-values()" "(let-values()"
"(let-values(((s96_0) s_0)" "(let-values(((s96_0) s_0)"
"((start97_0) start_0)" "((start97_0) start_0)"
"((temp98_0)(- end_0 7))" "((temp98_0)(fx- end_0 7))"
"((radix99_0) radix_0)" "((radix99_0) radix_0)"
"((exactness100_0) exactness_0)" "((exactness100_0) exactness_0)"
"((convert-mode101_0) convert-mode_0)" "((convert-mode101_0) convert-mode_0)"
@ -50436,12 +50436,12 @@ static const char *startup_source =
"(let-values(((c4_0)" "(let-values(((c4_0)"
"(if(char-sign? c_0)" "(if(char-sign? c_0)"
"(if(not in-complex_0)" "(if(not in-complex_0)"
"(if(>(- end_0 start_0) 7)" "(if(fx>(fx- end_0 start_0) 7)"
"(if(char=? '#\\@(string-ref s_0(+ start_0 6)))" "(if(char=? '#\\@(string-ref s_0(fx+ start_0 6)))"
"(read-special-number" "(read-special-number"
" s_0" " s_0"
" start_0" " start_0"
"(+ start_0 6)" "(fx+ start_0 6)"
" convert-mode_0)" " convert-mode_0)"
" #f)" " #f)"
" #f)" " #f)"
@ -50450,7 +50450,7 @@ static const char *startup_source =
"(if c4_0" "(if c4_0"
"((lambda(v_0)" "((lambda(v_0)"
"(let-values(((s106_0) s_0)" "(let-values(((s106_0) s_0)"
"((temp107_0)(+ start_0 7))" "((temp107_0)(fx+ start_0 7))"
"((end108_0) end_0)" "((end108_0) end_0)"
"((radix109_0) radix_0)" "((radix109_0) radix_0)"
"((exactness110_0) exactness_0)" "((exactness110_0) exactness_0)"
@ -50474,11 +50474,11 @@ static const char *startup_source =
" c4_0)" " c4_0)"
"(let-values(((c5_0)" "(let-values(((c5_0)"
"(if(not in-complex_0)" "(if(not in-complex_0)"
"(if(>(- end_0 start_0) 7)" "(if(fx>(fx- end_0 start_0) 7)"
"(if(char=? '#\\@(string-ref s_0(- end_0 7)))" "(if(char=? '#\\@(string-ref s_0(fx- end_0 7)))"
"(read-special-number" "(read-special-number"
" s_0" " s_0"
"(- end_0 6)" "(fx- end_0 6)"
" end_0" " end_0"
" convert-mode_0)" " convert-mode_0)"
" #f)" " #f)"
@ -50488,7 +50488,7 @@ static const char *startup_source =
"((lambda(v2_0)" "((lambda(v2_0)"
"(let-values(((s115_0) s_0)" "(let-values(((s115_0) s_0)"
"((start116_0) start_0)" "((start116_0) start_0)"
"((temp117_0)(- end_0 7))" "((temp117_0)(fx- end_0 7))"
"((radix118_0) radix_0)" "((radix118_0) radix_0)"
"((exactness119_0) exactness_0)" "((exactness119_0) exactness_0)"
"((convert-mode120_0) convert-mode_0)" "((convert-mode120_0) convert-mode_0)"
@ -50555,7 +50555,7 @@ static const char *startup_source =
" must-i?_0)" " must-i?_0)"
"(begin" "(begin"
" 'loop" " 'loop"
"(if(= i_0 end_0)" "(if(fx= i_0 end_0)"
"(let-values()" "(let-values()"
"(if(if(not any-digits?_0)(not i-pos_0) #f)" "(if(if(not any-digits?_0)(not i-pos_0) #f)"
"(let-values()" "(let-values()"
@ -50573,10 +50573,10 @@ static const char *startup_source =
"(let-values() #f)))" "(let-values() #f)))"
"(if(if sign-pos_0" "(if(if sign-pos_0"
"(let-values(((or-part_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" "(if or-part_0"
" 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)" " #f)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
@ -50591,7 +50591,7 @@ static const char *startup_source =
"((start134_0) start_0)" "((start134_0) start_0)"
"((sign-pos135_0) sign-pos_0)" "((sign-pos135_0) sign-pos_0)"
"((sign-pos136_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)" "((i-pos138_0) i-pos_0)"
"((sign-pos139_0) sign-pos_0)" "((sign-pos139_0) sign-pos_0)"
"((radix140_0) radix_0)" "((radix140_0) radix_0)"
@ -50617,7 +50617,7 @@ static const char *startup_source =
"(let-values(((s145_0) s_0)" "(let-values(((s145_0) s_0)"
"((start146_0) start_0)" "((start146_0) start_0)"
"((@-pos147_0) @-pos_0)" "((@-pos147_0) @-pos_0)"
"((temp148_0)(add1 @-pos_0))" "((temp148_0)(fx+ 1 @-pos_0))"
"((end149_0) end_0)" "((end149_0) end_0)"
"((i-pos150_0) i-pos_0)" "((i-pos150_0) i-pos_0)"
"((sign-pos151_0) sign-pos_0)" "((sign-pos151_0) sign-pos_0)"
@ -50656,7 +50656,7 @@ static const char *startup_source =
"(if(digit? c_0 radix_0)" "(if(digit? c_0 radix_0)"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" #t" " #t"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50669,7 +50669,7 @@ static const char *startup_source =
"(if(char=? c_0 '#\\#)" "(if(char=? c_0 '#\\#)"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" #t" " #t"
" #t" " #t"
" i-pos_0" " i-pos_0"
@ -50691,7 +50691,7 @@ static const char *startup_source =
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50700,9 +50700,9 @@ static const char *startup_source =
" dot-pos_0" " dot-pos_0"
" slash-pos_0" " slash-pos_0"
" #f" " #f"
"(if(> i_0 start_0)" "(if(fx> i_0 start_0)"
"(let-values(((or-part_0)(not @-pos_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)))))" " #f)))))"
"(if(char=? c_0 '#\\.)" "(if(char=? c_0 '#\\.)"
"(let-values()" "(let-values()"
@ -50712,7 +50712,7 @@ static const char *startup_source =
"(not sign-pos_0)))" "(not sign-pos_0)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(> exp-pos_0 sign-pos_0)))" "(fx> exp-pos_0 sign-pos_0)))"
" #f)))" " #f)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -50720,7 +50720,7 @@ static const char *startup_source =
"(let-values(((or-part_1)(not sign-pos_0)))" "(let-values(((or-part_1)(not sign-pos_0)))"
"(if or-part_1" "(if or-part_1"
" or-part_1" " or-part_1"
"(> dot-pos_0 sign-pos_0)))" "(fx> dot-pos_0 sign-pos_0)))"
" #f)))" " #f)))"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(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)))" "(let-values(((or-part_0)(not sign-pos_0)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(> slash-pos_0 sign-pos_0)))" "(fx> slash-pos_0 sign-pos_0)))"
" #f)" " #f)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
@ -50744,7 +50744,7 @@ static const char *startup_source =
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50760,7 +50760,7 @@ static const char *startup_source =
"(let-values(((or-part_0)(not sign-pos_0)))" "(let-values(((or-part_0)(not sign-pos_0)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(> dot-pos_0 sign-pos_0)))" "(fx> dot-pos_0 sign-pos_0)))"
" #f)" " #f)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
@ -50775,7 +50775,7 @@ static const char *startup_source =
"(not sign-pos_0)))" "(not sign-pos_0)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(> exp-pos_0 sign-pos_0)))" "(fx> exp-pos_0 sign-pos_0)))"
" #f)))" " #f)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
@ -50783,7 +50783,7 @@ static const char *startup_source =
"(let-values(((or-part_1)(not sign-pos_0)))" "(let-values(((or-part_1)(not sign-pos_0)))"
"(if or-part_1" "(if or-part_1"
" or-part_1" " or-part_1"
"(> slash-pos_0 sign-pos_0)))" "(fx> slash-pos_0 sign-pos_0)))"
" #f)))" " #f)))"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
@ -50794,7 +50794,7 @@ static const char *startup_source =
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50868,12 +50868,12 @@ static const char *startup_source =
" c_0" " c_0"
"(substring s_0 start_0 end_0)))" "(substring s_0 start_0 end_0)))"
"(let-values() #f)))" "(let-values() #f)))"
"(if(if(<(add1 i_0) end_0)" "(if(if(fx<(fx+ 1 i_0) end_0)"
"(char-sign?(string-ref s_0(add1 i_0)))" "(char-sign?(string-ref s_0(fx+ 1 i_0)))"
" #f)" " #f)"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(+ i_0 2)" "(fx+ i_0 2)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50886,7 +50886,7 @@ static const char *startup_source =
" must-i?_0))" " must-i?_0))"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(+ i_0 1)" "(fx+ i_0 1)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50918,7 +50918,7 @@ static const char *startup_source =
" \"too many `@`s in `~.a`\"" " \"too many `@`s in `~.a`\""
"(substring s_0 start_0 end_0)))" "(substring s_0 start_0 end_0)))"
"(let-values() #f)))" "(let-values() #f)))"
"(if(= i_0 start_0)" "(if(fx= i_0 start_0)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
"(let-values()" "(let-values()"
@ -50936,7 +50936,7 @@ static const char *startup_source =
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i-pos_0" " i-pos_0"
@ -50963,7 +50963,7 @@ static const char *startup_source =
"(substring s_0 start_0 end_0)))" "(substring s_0 start_0 end_0)))"
"(let-values() #f)))" "(let-values() #f)))"
"(if(let-values(((or-part_0)" "(if(let-values(((or-part_0)"
"(<(add1 i_0) end_0)))" "(fx<(fx+ 1 i_0) end_0)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(eq? in-complex_0 'i)))" "(eq? in-complex_0 'i)))"
@ -50976,7 +50976,7 @@ static const char *startup_source =
"(let-values() #f)))" "(let-values() #f)))"
"(let-values()" "(let-values()"
"(loop_0" "(loop_0"
"(add1 i_0)" "(fx+ 1 i_0)"
" any-digits?_0" " any-digits?_0"
" any-hashes?_0" " any-hashes?_0"
" i_0" " i_0"
@ -51039,7 +51039,7 @@ static const char *startup_source =
"(let-values(((convert-mode_0) convert-mode46_0))" "(let-values(((convert-mode_0) convert-mode46_0))"
"(let-values()" "(let-values()"
"(let-values(((v1_0)" "(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()(if(eq? exactness_0 'inexact) 0.0 0))"
"(let-values()" "(let-values()"
"(let-values(((s157_0) s_0)" "(let-values(((s157_0) s_0)"
@ -51060,7 +51060,7 @@ static const char *startup_source =
" exactness162_0" " exactness162_0"
" convert-mode164_0))))))" " convert-mode164_0))))))"
"(let-values(((v2_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()"
"(let-values(((neg?_0)(char=?(string-ref s_0 start2_0) '#\\-)))" "(let-values(((neg?_0)(char=?(string-ref s_0 start2_0) '#\\-)))"
"(if(eq? exactness_0 'inexact)" "(if(eq? exactness_0 'inexact)"
@ -51128,10 +51128,10 @@ static const char *startup_source =
" #f)" " #f)"
" #f)" " #f)"
" #f)))" " #f)))"
"(let-values(((has-sign?_0)(if(> end_0 start_0)(char-sign?(string-ref s_0 start_0)) #f)))" "(let-values(((has-sign?_0)(if(fx> 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)))" "(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()" "(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\")) (let-values () #f))"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
" (let-values () (format \"missing digits in `~.a`\" (substring s_0 start_0 end_0)))" " (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" "(if simple?_0"
"(let-values()" "(let-values()"
"(if(if exp-pos_0" "(if(if exp-pos_0"
"(=" "(fx="
"(- exp-pos_0 start_0)" "(fx- 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+(if(if dot-pos_0(fx< dot-pos_0 exp-pos_0) #f) 1 0)(if has-sign?_0 1 0)))"
" #f)" " #f)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(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)))" " (format \"missing digits before exponent marker in `~.a`\" (substring s_0 start_0 end_0)))"
"(let-values() #f)))" "(let-values() #f)))"
"(if(if exp-pos_0" "(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" "(if or-part_0"
" 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)" " #f)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
@ -51206,7 +51206,7 @@ static const char *startup_source =
" 'exact" " 'exact"
" convert-mode_0)))" " convert-mode_0)))"
"(let-values(((e-v_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)" "(let-values(((real->precision-inexact_0)"
"(lambda(r_0)" "(lambda(r_0)"
"(begin" "(begin"
@ -51283,7 +51283,7 @@ static const char *startup_source =
"(let-values(((d-v_0)" "(let-values(((d-v_0)"
"(string->real-number" "(string->real-number"
" s_0" " s_0"
"(add1 slash-pos_0)" "(fx+ 1 slash-pos_0)"
" end_0" " end_0"
" #f" " #f"
" #f" " #f"
@ -51310,7 +51310,7 @@ static const char *startup_source =
"(let-values() d-v_0)" "(let-values() d-v_0)"
"(if(eqv? d-v_0 0)" "(if(eqv? d-v_0 0)"
"(let-values()" "(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(negative? n-v_0) -inf.0 +inf.0))"
"(let-values()" "(let-values()"
"(if(eq?(read-complains convert-mode_0) 'must-read)" "(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(((get-exact?_0)"
"(let-values(((or-part_0)(eq? exactness_0 'exact)))" "(let-values(((or-part_0)(eq? exactness_0 'exact)))"
"(if or-part_0 or-part_0(eq? exactness_0 'decimal-as-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)" "((letrec-values(((loop_0)"
"(lambda(i_0 j_0 hashes-pos_0)" "(lambda(i_0 j_0 hashes-pos_0)"
"(begin" "(begin"
" 'loop" " 'loop"
"(if(< i_0 start_0)" "(if(fx< i_0 start_0)"
"(let-values()" "(let-values()"
"(if(= hashes-pos_0 start_0)" "(if(fx= hashes-pos_0 start_0)"
"(let-values()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
"(let-values()" "(let-values()"
@ -51352,7 +51352,7 @@ static const char *startup_source =
" -0.0" " -0.0"
"(exact->inexact n_0)))" "(exact->inexact n_0)))"
"(if(if dot-pos_0 get-exact?_0 #f)" "(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() n_0))))))))"
"(let-values()" "(let-values()"
"(let-values(((c_0)(string-ref s_0 i_0)))" "(let-values(((c_0)(string-ref s_0 i_0)))"
@ -51360,30 +51360,33 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(if get-exact?_0" "(if get-exact?_0"
"(let-values()" "(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()" "(let-values()"
"(begin" "(begin"
"(string-set! new-str_0 j_0 c_0)" "(string-set! new-str_0 j_0 c_0)"
"(loop_0" "(loop_0"
"(sub1 i_0)" "(fx- i_0 1)"
"(sub1 j_0)" "(fx- j_0 1)"
"(if(= hashes-pos_0(add1 i_0)) i_0 hashes-pos_0))))))" "(if(fx= hashes-pos_0(fx+ 1 i_0)) i_0 hashes-pos_0))))))"
"(if(let-values(((or-part_0)(char=? c_0 '#\\-)))" "(if(let-values(((or-part_0)(char=? c_0 '#\\-)))"
"(if or-part_0 or-part_0(char=? c_0 '#\\+)))" "(if or-part_0 or-part_0(char=? c_0 '#\\+)))"
"(let-values()" "(let-values()"
"(begin" "(begin"
"(string-set! new-str_0 j_0 c_0)" "(string-set! new-str_0 j_0 c_0)"
"(loop_0" "(loop_0"
"(sub1 i_0)" "(fx- i_0 1)"
"(sub1 j_0)" "(fx- j_0 1)"
"(if(= hashes-pos_0(add1 i_0)) i_0 hashes-pos_0))))" "(if(fx= hashes-pos_0(fx+ 1 i_0)) i_0 hashes-pos_0))))"
"(if(char=? c_0 '#\\#)" "(if(char=? c_0 '#\\#)"
"(let-values()" "(let-values()"
"(if(= hashes-pos_0(add1 i_0))" "(if(fx= hashes-pos_0(fx+ 1 i_0))"
"(let-values()" "(let-values()"
"(begin" "(begin"
"(string-set! new-str_0 j_0 '#\\0)" "(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()" "(let-values()"
"(if(eq? convert-mode_0 'must-read)" "(if(eq? convert-mode_0 'must-read)"
"(let-values()" "(let-values()"
@ -51392,10 +51395,10 @@ static const char *startup_source =
"(let-values()" "(let-values()"
"(begin" "(begin"
"(string-set! new-str_0 j_0 c_0)" "(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)" " loop_0)"
"(sub1 end_0)" "(fx- end_0 1)"
"(sub1(string-length new-str_0))" "(fx-(string-length new-str_0) 1)"
" end_0))))))" " end_0))))))"
"(define-values" "(define-values"
"(string->exact-integer-number)" "(string->exact-integer-number)"
@ -51418,27 +51421,27 @@ static const char *startup_source =
"(read-special-number)" "(read-special-number)"
"(lambda(s_0 start_0 end_0 convert-mode_0)" "(lambda(s_0 start_0 end_0 convert-mode_0)"
"(begin" "(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(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) '#\\-)))" "(if or-part_0 or-part_0(char=?(string-ref s_0 start_0) '#\\-)))"
"(let-values(((or-part_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(fx+ start_0 1))) '#\\i)"
"(if(char=?(char-downcase(string-ref s_0(+ start_0 2))) '#\\n)" "(if(char=?(char-downcase(string-ref s_0(fx+ start_0 2))) '#\\n)"
"(if(char=?(char-downcase(string-ref s_0(+ start_0 3))) '#\\f)" "(if(char=?(char-downcase(string-ref s_0(fx+ 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 4))) '#\\.)"
"(let-values(((or-part_0)" "(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)" "(if(char=?(string-ref s_0 start_0) '#\\+) +inf.0 -inf.0)"
" #f)))" " #f)))"
"(if or-part_0" "(if or-part_0"
" or-part_0" " or-part_0"
"(let-values(((or-part_1)" "(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)" "(if(char=?(string-ref s_0 start_0) '#\\+) +inf.f -inf.f)"
" #f)))" " #f)))"
"(if or-part_1" "(if or-part_1"
" 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(not(eq? convert-mode_0 'number-or-false))"
"(if(char=?(string-ref s_0 start_0) '#\\+) '+inf.t '-inf.t)" "(if(char=?(string-ref s_0 start_0) '#\\+) '+inf.t '-inf.t)"
" #f)" " #f)"
@ -51449,19 +51452,19 @@ static const char *startup_source =
" #f)))" " #f)))"
"(if or-part_0" "(if or-part_0"
" 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(fx+ start_0 1))) '#\\n)"
"(if(char=?(char-downcase(string-ref s_0(+ start_0 2))) '#\\a)" "(if(char=?(char-downcase(string-ref s_0(fx+ start_0 2))) '#\\a)"
"(if(char=?(char-downcase(string-ref s_0(+ start_0 3))) '#\\n)" "(if(char=?(char-downcase(string-ref s_0(fx+ 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 4))) '#\\.)"
"(let-values(((or-part_1)" "(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" "(if or-part_1"
" or-part_1" " or-part_1"
"(let-values(((or-part_2)" "(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" "(if or-part_2"
" 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)" "(if(not(eq? convert-mode_0 'number-or-false)) '+nan.t #f)"
" #f)))))" " #f)))))"
" #f)" " #f)"
@ -51576,7 +51579,7 @@ static const char *startup_source =
"(replace-hashes)" "(replace-hashes)"
"(lambda(s_0 start_0 end_0)" "(lambda(s_0 start_0 end_0)"
"(begin" "(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" "(begin"
"(let-values(((v*_0 start*_0 stop*_0 step*_0)" "(let-values(((v*_0 start*_0 stop*_0 step*_0)"
"(normalise-inputs" "(normalise-inputs"
@ -51621,7 +51624,7 @@ static const char *startup_source =
"(define-values" "(define-values"
"(maybe-substring)" "(maybe-substring)"
"(lambda(s_0 start_0 end_0)" "(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" "(define-values"
"(exactness-set?)" "(exactness-set?)"
"(lambda(exactness_0)" "(lambda(exactness_0)"
@ -51634,15 +51637,17 @@ static const char *startup_source =
"(lambda(c_0 radix_0)" "(lambda(c_0 radix_0)"
"(begin" "(begin"
"(let-values(((v_0)(char->integer c_0)))" "(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" "(if or-part_0"
" or-part_0" " or-part_0"
"(if(> radix_0 10)" "(if(fx> radix_0 10)"
"(let-values(((or-part_1)" "(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" "(if or-part_1"
" 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)))))))" " #f)))))))"
"(define-values" "(define-values"
"(fail-bad-number)" "(fail-bad-number)"