diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt index 60cb98c7dd..a73d0fd880 100644 --- a/racket/collects/racket/private/for.rkt +++ b/racket/collects/racket/private/for.rkt @@ -942,6 +942,9 @@ (check-ranges who type-name vec start stop* step len) (values vec start stop* step))) + (define (unsafe-normalise-inputs unsafe-vector-length vec start stop step) + (values vec start (or stop (unsafe-vector-length vec)) step)) + (define-syntax define-in-vector-like (syntax-rules () [(define-in-vector-like (in-vector-name check-vector-name) @@ -1034,12 +1037,15 @@ ;; Outer bindings ;; start*, stop*, and step* are guaranteed to be exact integers ([(v* start* stop* step*) - (normalise-inputs (quote in-vector-name) type-name - ;; reverse-eta triggers JIT inlining of - ;; primitives, which is good for futures: - (lambda (x) (vector? x)) - (lambda (x) (unsafe-vector-length x)) - vec-expr start stop step)]) + (if (variable-reference-from-unsafe? (#%variable-reference)) + (unsafe-normalise-inputs unsafe-vector-length + vec-expr start stop step) + (normalise-inputs (quote in-vector-name) type-name + ;; reverse-eta triggers JIT inlining of + ;; primitives, which is good for futures: + (lambda (x) (vector? x)) + (lambda (x) (unsafe-vector-length x)) + vec-expr start stop step))]) ;; Outer check is done by normalise-inputs #t ;; Loop bindings diff --git a/racket/src/cs/io.sls b/racket/src/cs/io.sls index 17eaca8955..59b90d054e 100644 --- a/racket/src/cs/io.sls +++ b/racket/src/cs/io.sls @@ -219,16 +219,32 @@ (ftype-ref rktio_convert_result_t (in_consumed) p) (ftype-ref rktio_convert_result_t (out_produced) p) (ftype-ref rktio_convert_result_t (converted) p)))) - (define (cast v from to) - (let ([p (malloc from)]) - (ptr-set! p from v) - (ptr-ref p to))) + (define (copy-bytes x i) + (let ([bstr (make-bytevector i)]) + (let loop ([j 0]) + (unless (fx= j i) + (bytes-set! bstr j (foreign-ref 'unsigned-8 x j)) + (loop (fx+ j 1)))) + bstr)) + + (define (copy-terminated-bytes x) + (let loop ([i 0]) + (if (fx= 0 (foreign-ref 'unsigned-8 x i)) + (copy-bytes x i) + (loop (fx+ i 1))))) + + (define (copy-terminated-shorts x) + (let loop ([i 0]) + (if (fx= 0 (foreign-ref 'unsigned-16 x i)) + (copy-bytes x i) + (loop (fx+ i 2))))) + (define (rktio_to_bytes fs) - (cast (ptr->address fs) _uintptr _bytes)) + (copy-terminated-bytes (ptr->address fs))) (define (rktio_to_shorts fs) - (cast (ptr->address fs) _uintptr _short_bytes)) + (copy-terminated-shorts (ptr->address fs))) ;; Unlike `rktio_to_bytes`, frees the array and strings (define rktio_to_bytes_list @@ -244,7 +260,7 @@ (let ([bs (foreign-ref 'uptr (ptr->address lls) (* i (foreign-sizeof 'uptr)))]) (if (not (eqv? NULL bs)) (cons (begin0 - (cast bs _uintptr _bytes) + (copy-terminated-bytes bs) (rktio_free (make-ptr bs))) (loop (add1 i))) '()))])) diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index 6d390f3604..842a9061cc 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -751,27 +751,32 @@ (unsafe-bytes-length bstr_0))) (case-lambda ((new-bstr_0 used_0 status_0) - (let ((done_0 - (string->bytes/locale - (norm_0 - (norm-tail_0 - (bytes->string/locale new-bstr_0)))))) - (if (eq? status_0 'complete) - done_0 - (if (eq? status_0 'aborts) - (bytes-append - done_0 - (subbytes bstr_0 (+ offset_0 used_0))) - (let ((app_0 - (let ((app_0 (+ offset_0 used_0))) - (subbytes - bstr_0 - app_0 - (+ offset_0 used_0 1))))) - (bytes-append - done_0 - app_0 - (loop_0 bstr_0 c_0 (+ offset_0 used_0 1)))))))) + (let ((s_0 (bytes->string/locale new-bstr_0))) + (let ((tail-s_0 + (if (eq? status_0 'complete) + (norm-tail_0 s_0) + s_0))) + (let ((done_0 + (string->bytes/locale (norm_0 tail-s_0)))) + (if (eq? status_0 'complete) + done_0 + (if (eq? status_0 'aborts) + (bytes-append + done_0 + (subbytes bstr_0 (+ offset_0 used_0))) + (let ((app_0 + (let ((app_0 (+ offset_0 used_0))) + (subbytes + bstr_0 + app_0 + (+ offset_0 used_0 1))))) + (bytes-append + done_0 + app_0 + (loop_0 + bstr_0 + c_0 + (+ offset_0 used_0 1)))))))))) (args (raise-binding-result-arity-error 3 args)))))))) (norm-tail_0 (|#%name| @@ -3055,6 +3060,13 @@ (begin (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0) (values vec_0 start_0 stop*_0 step_0))))))) +(define unsafe-normalise-inputs + (lambda (unsafe-vector-length_0 vec_0 start_0 stop_0 step_0) + (values + vec_0 + start_0 + (if stop_0 stop_0 (|#%app| unsafe-vector-length_0 vec_0)) + step_0))) (define check-vector (lambda (v_0) (if (vector? v_0) (void) (raise-argument-error 'in-vector "vector" v_0)))) @@ -6953,9 +6965,7 @@ (define all-fields-immutable? (lambda (k_0) (prefab-key-all-fields-immutable? k_0))) (define datum-map-slow - (letrec ((procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (loop_0 + (letrec ((loop_0 (|#%name| loop (lambda (f_0 known-pairs_0 tail?_0 s_0 prev-seen_0) @@ -7100,11 +7110,8 @@ (reverse$1 (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector s_0) 1 #f @@ -23261,11 +23268,7 @@ (define fasl-hash-equal-variant 1) (define fasl-hash-eqv-variant 2) (define s-exp->fasl.1 - (letrec ((procz4 (lambda (x_0) (unsafe-vector-length x_0))) - (procz3 (lambda (x_0) (vector? x_0))) - (procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (loop_0 + (letrec ((loop_0 (|#%name| loop (lambda (external-lift?7_0 @@ -23395,11 +23398,8 @@ c1_0) (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector v_0) 1 #f @@ -24009,11 +24009,8 @@ o_0) (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz3 - procz4 + (unsafe-normalise-inputs + unsafe-vector-length vec_0 1 #f @@ -26072,13 +26069,7 @@ fold-var_0)))))) (for-loop_0 null phases-in-order_0))))))))) (define generate-deserialize.1 - (letrec ((procz6 (lambda (x_0) (unsafe-vector-length x_0))) - (procz5 (lambda (x_0) (vector? x_0))) - (procz4 (lambda (x_0) (unsafe-vector-length x_0))) - (procz3 (lambda (x_0) (vector? x_0))) - (procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (finish_0 + (letrec ((finish_0 (|#%name| finish (lambda (mutables_0 @@ -26407,11 +26398,8 @@ (begin (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector v_0) 1 #f @@ -26459,11 +26447,8 @@ (begin (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz3 - procz4 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector v_0) 1 #f @@ -26867,11 +26852,8 @@ (let ((all-quoted?_0 (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz5 - procz6 + (unsafe-normalise-inputs + unsafe-vector-length vec_0 1 #f @@ -28925,203 +28907,191 @@ "bad fill encoding: ~v" (unsafe-vector*-ref vec_0 pos_0))))))))))) (define find-reachable-scopes - (letrec ((procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0)))) - (lambda (v_0) - (let ((seen_0 (make-hasheq))) - (let ((reachable-scopes_0 (seteq))) - (let ((get-reachable-scopes_0 + (lambda (v_0) + (let ((seen_0 (make-hasheq))) + (let ((reachable-scopes_0 (seteq))) + (let ((get-reachable-scopes_0 + (|#%name| + get-reachable-scopes + (lambda () (begin reachable-scopes_0))))) + (let ((scope-triggers_0 (make-hasheq))) + (begin + (letrec* + ((loop_0 (|#%name| - get-reachable-scopes - (lambda () (begin reachable-scopes_0))))) - (let ((scope-triggers_0 (make-hasheq))) - (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (v_1) - (begin - (if (interned-literal? v_1) + loop + (lambda (v_1) + (begin + (if (interned-literal? v_1) + (void) + (if (hash-ref seen_0 v_1 #f) (void) - (if (hash-ref seen_0 v_1 #f) - (void) - (begin - (hash-set! seen_0 v_1 #t) - (if (scope-with-bindings? v_1) - (begin - (set! reachable-scopes_0 - (let ((s_0 reachable-scopes_0)) - (hash-set s_0 v_1 #t))) - (|#%app| (reach-scopes-ref v_1) v_1 loop_0) - (let ((lst_0 - (hash-ref scope-triggers_0 v_1 null))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((proc_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr lst_1))) - (begin - (|#%app| proc_0 loop_0) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 lst_0)))) - (void) - (hash-remove! scope-triggers_0 v_1) - (|#%app| - (scope-with-bindings-ref v_1) - v_1 - get-reachable-scopes_0 - loop_0 - (lambda (sc-unreachable_0 b_0) - (let ((xform_0 - (lambda (l_0) (cons b_0 l_0)))) - (do-hash-update - 'hash-update! - #t - hash-set! - scope-triggers_0 - sc-unreachable_0 - xform_0 - null))))) - (if (reach-scopes? v_1) - (|#%app| (reach-scopes-ref v_1) v_1 loop_0) - (if (pair? v_1) - (begin - (loop_0 (car v_1)) - (loop_0 (cdr v_1))) - (if (vector? v_1) - (begin - (call-with-values - (lambda () - (begin - (check-vector v_1) - (values - v_1 - (unsafe-vector-length v_1)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (pos_0) - (begin - (if (unsafe-fx< - pos_0 - len_0) - (let ((e_0 - (unsafe-vector-ref - vec_0 - pos_0))) - (begin - (loop_0 e_0) - (for-loop_0 - (unsafe-fx+ - 1 - pos_0)))) - (values))))))) - (for-loop_0 0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (void)) - (if (box? v_1) - (loop_0 (unbox v_1)) - (if (hash? v_1) + (begin + (hash-set! seen_0 v_1 #t) + (if (scope-with-bindings? v_1) + (begin + (set! reachable-scopes_0 + (let ((s_0 reachable-scopes_0)) + (hash-set s_0 v_1 #t))) + (|#%app| (reach-scopes-ref v_1) v_1 loop_0) + (let ((lst_0 + (hash-ref scope-triggers_0 v_1 null))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - v_1 - i_0)) - (case-lambda - ((k_0 v_2) - (begin - (begin - (loop_0 k_0) - (loop_0 v_2)) - (for-loop_0 - (hash-iterate-next - v_1 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values))))))) - (for-loop_0 - (hash-iterate-first v_1)))) - (void)) - (if (prefab-struct-key v_1) - (begin - (call-with-values - (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 - (struct->vector v_1) - 1 - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) + (if (pair? lst_1) + (let ((proc_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr lst_1))) + (begin + (|#%app| proc_0 loop_0) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 lst_0)))) + (void) + (hash-remove! scope-triggers_0 v_1) + (|#%app| + (scope-with-bindings-ref v_1) + v_1 + get-reachable-scopes_0 + loop_0 + (lambda (sc-unreachable_0 b_0) + (let ((xform_0 + (lambda (l_0) (cons b_0 l_0)))) + (do-hash-update + 'hash-update! + #t + hash-set! + scope-triggers_0 + sc-unreachable_0 + xform_0 + null))))) + (if (reach-scopes? v_1) + (|#%app| (reach-scopes-ref v_1) v_1 loop_0) + (if (pair? v_1) + (begin (loop_0 (car v_1)) (loop_0 (cdr v_1))) + (if (vector? v_1) + (begin + (call-with-values + (lambda () + (begin + (check-vector v_1) + (values + v_1 + (unsafe-vector-length v_1)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (pos_0) (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0) + (if (unsafe-fx< pos_0 len_0) + (let ((e_0 + (unsafe-vector-ref + vec_0 + pos_0))) + (begin + (loop_0 e_0) + (for-loop_0 + (unsafe-fx+ + 1 + pos_0)))) + (values))))))) + (for-loop_0 0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (void)) + (if (box? v_1) + (loop_0 (unbox v_1)) + (if (hash? v_1) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value + v_1 + i_0)) + (case-lambda + ((k_0 v_2) (begin - (if (unsafe-fx< - idx_0 - stop*_0) - (let ((e_0 - (unsafe-vector-ref - v*_0 - idx_0))) - (begin - (loop_0 e_0) - (for-loop_0 - (unsafe-fx+ - idx_0 - 1)))) - (values))))))) - (for-loop_0 start*_0)))) - (args - (raise-binding-result-arity-error - 4 - args)))) - (void)) - (if (srcloc? v_1) - (loop_0 (srcloc-source v_1)) - (void))))))))))))))))) - (loop_0 v_0)) - reachable-scopes_0)))))))) + (begin + (loop_0 k_0) + (loop_0 v_2)) + (for-loop_0 + (hash-iterate-next + v_1 + i_0)))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values))))))) + (for-loop_0 + (hash-iterate-first v_1)))) + (void)) + (if (prefab-struct-key v_1) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-vector-length + (struct->vector v_1) + 1 + #f + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0) + (begin + (if (unsafe-fx< + idx_0 + stop*_0) + (let ((e_0 + (unsafe-vector-ref + v*_0 + idx_0))) + (begin + (loop_0 e_0) + (for-loop_0 + (unsafe-fx+ + idx_0 + 1)))) + (values))))))) + (for-loop_0 start*_0)))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (void)) + (if (srcloc? v_1) + (loop_0 (srcloc-source v_1)) + (void))))))))))))))))) + (loop_0 v_0)) + reachable-scopes_0))))))) (define deserialize-imports '(deserialize-module-path-indexes syntax-module-path-index-shift diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 4eea9444ab..3586604018 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -2328,6 +2328,13 @@ (begin (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0) (values vec_0 start_0 stop*_0 step_0))))))) +(define unsafe-normalise-inputs + (lambda (unsafe-vector-length_0 vec_0 start_0 stop_0 step_0) + (values + vec_0 + start_0 + (if stop_0 stop_0 (|#%app| unsafe-vector-length_0 vec_0)) + step_0))) (define check-vector (lambda (v_0) (if (vector? v_0) (void) (raise-argument-error 'in-vector "vector" v_0)))) @@ -5613,8 +5620,8 @@ (let ((app_0 (fx- in-end_0 in-start_0))) (values app_0 (fx- j_0 out-start_0) 'complete)) (let ((b_0 (char->integer (string-ref in-str_0 i_0)))) - (if (<= b_0 127) - (if (if out-end_0 (= j_0 out-end_0) #f) + (if (fx<= b_0 127) + (if (if out-end_0 (fx= j_0 out-end_0) #f) (let ((app_0 (fx- i_0 in-start_0))) (values app_0 (fx- j_0 out-start_0) 'continues)) (begin @@ -5630,7 +5637,7 @@ out-end_0 out-start_0 (fx+ j_0 1)))) - (if (<= b_0 2047) + (if (fx<= b_0 2047) (if (if out-end_0 (fx>= (fx+ j_0 1) out-end_0) #f) (let ((app_0 (fx- i_0 in-start_0))) (values app_0 (fx- j_0 out-start_0) 'continues)) @@ -5640,12 +5647,12 @@ (unsafe-bytes-set! out-bstr_0 j_0 - (bitwise-ior 192 (arithmetic-shift b_0 -6))) - (let ((app_0 (add1 j_0))) + (fxior 192 (fxrshift b_0 6))) + (let ((app_0 (fx+ j_0 1))) (unsafe-bytes-set! out-bstr_0 app_0 - (bitwise-ior 128 (bitwise-and b_0 63))))) + (fxior 128 (fxand b_0 63))))) (void)) (continue_0 i_0 @@ -5666,23 +5673,17 @@ (unsafe-bytes-set! out-bstr_0 j_0 - (bitwise-ior - 224 - (arithmetic-shift b_0 -12))) + (fxior 224 (fxrshift b_0 12))) (let ((app_0 (fx+ j_0 1))) (unsafe-bytes-set! out-bstr_0 app_0 - (bitwise-ior - 128 - (bitwise-and - (arithmetic-shift b_0 -6) - 63)))) + (fxior 128 (fxand (fxrshift b_0 6) 63)))) (let ((app_0 (fx+ j_0 2))) (unsafe-bytes-set! out-bstr_0 app_0 - (bitwise-ior 128 (bitwise-and b_0 63))))) + (fxior 128 (fxand b_0 63))))) (void)) (continue_0 i_0 @@ -5702,32 +5703,24 @@ (unsafe-bytes-set! out-bstr_0 j_0 - (bitwise-ior - 240 - (arithmetic-shift b_0 -18))) + (fxior 240 (fxrshift b_0 18))) (let ((app_0 (fx+ j_0 1))) (unsafe-bytes-set! out-bstr_0 app_0 - (bitwise-ior + (fxior 128 - (bitwise-and - (arithmetic-shift b_0 -12) - 63)))) + (fxand (fxrshift b_0 12) 63)))) (let ((app_0 (fx+ j_0 2))) (unsafe-bytes-set! out-bstr_0 app_0 - (bitwise-ior - 128 - (bitwise-and - (arithmetic-shift b_0 -6) - 63)))) + (fxior 128 (fxand (fxrshift b_0 6) 63)))) (let ((app_0 (fx+ j_0 3))) (unsafe-bytes-set! out-bstr_0 app_0 - (bitwise-ior 128 (bitwise-and b_0 63))))) + (fxior 128 (fxand b_0 63))))) (void)) (continue_0 i_0 @@ -11227,9 +11220,7 @@ (if (fd-output-port-bstr this-id_0) (loop_0) (void))))))))) (loop_0)))))) (define temp20.1 - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0))) - (for-loop_0 + (letrec ((for-loop_0 (|#%name| for-loop (lambda (enable-break?633_0 stop*_0 this-id_0 v*_0 idx_0) @@ -11274,11 +11265,8 @@ (begin (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-bytes-length src-bstr630_0 src-start631_0 src-end632_0 @@ -16449,8 +16437,8 @@ v_0 next-i_0) (begin - (if (<= v_0 127) - (if (if out-end24_0 (= j_0 out-end24_0) #f) + (if (fx<= v_0 127) + (if (if out-end24_0 (fx= j_0 out-end24_0) #f) (let ((app_0 (fx- i_0 in-start20_0))) (values app_0 (fx- j_0 out-start23_0) 'continues)) (begin @@ -16470,7 +16458,7 @@ out-start23_0 next-i_0 next-j_0))))) - (if (<= v_0 2047) + (if (fx<= v_0 2047) (if (if out-end24_0 (fx>= (fx+ j_0 1) out-end24_0) #f) (let ((app_0 (fx- i_0 in-start20_0))) (values app_0 (fx- j_0 out-start23_0) 'continues)) @@ -16480,12 +16468,12 @@ (unsafe-bytes-set! out-bstr22_0 j_0 - (bitwise-ior 192 (arithmetic-shift v_0 -6))) - (let ((app_0 (add1 j_0))) + (fxior 192 (fxrshift v_0 6))) + (let ((app_0 (fx+ j_0 1))) (unsafe-bytes-set! out-bstr22_0 app_0 - (bitwise-ior 128 (bitwise-and v_0 63))))) + (fxior 128 (fxand v_0 63))))) (void)) (let ((next-j_0 (+ j_0 2))) (begin @@ -16510,21 +16498,17 @@ (unsafe-bytes-set! out-bstr22_0 j_0 - (bitwise-ior 224 (arithmetic-shift v_0 -12))) + (fxior 224 (fxrshift v_0 12))) (let ((app_0 (fx+ j_0 1))) (unsafe-bytes-set! out-bstr22_0 app_0 - (bitwise-ior - 128 - (bitwise-and - (arithmetic-shift v_0 -6) - 63)))) + (fxior 128 (fxand (fxrshift v_0 6) 63)))) (let ((app_0 (fx+ j_0 2))) (unsafe-bytes-set! out-bstr22_0 app_0 - (bitwise-ior 128 (bitwise-and v_0 63))))) + (fxior 128 (fxand v_0 63))))) (void)) (let ((next-j_0 (fx+ j_0 3))) (begin @@ -16548,30 +16532,22 @@ (unsafe-bytes-set! out-bstr22_0 j_0 - (bitwise-ior 240 (arithmetic-shift v_0 -18))) + (fxior 240 (fxrshift v_0 18))) (let ((app_0 (fx+ j_0 1))) (unsafe-bytes-set! out-bstr22_0 app_0 - (bitwise-ior - 128 - (bitwise-and - (arithmetic-shift v_0 -12) - 63)))) + (fxior 128 (fxand (fxrshift v_0 12) 63)))) (let ((app_0 (fx+ j_0 2))) (unsafe-bytes-set! out-bstr22_0 app_0 - (bitwise-ior - 128 - (bitwise-and - (arithmetic-shift v_0 -6) - 63)))) + (fxior 128 (fxand (fxrshift v_0 6) 63)))) (let ((app_0 (fx+ j_0 3))) (unsafe-bytes-set! out-bstr22_0 app_0 - (bitwise-ior 128 (bitwise-and v_0 63))))) + (fxior 128 (fxand v_0 63))))) (void)) (let ((next-j_0 (fx+ j_0 4))) (begin @@ -17499,196 +17475,184 @@ (|#%app| rktio_convert_reset (unsafe-place-local-ref cell.1) c_0))))) (define ucs-4-encoding (if (system-big-endian?) "UCS-4BE" "UCS-4LE")) (define string->bytes/ucs-4 - (letrec ((procz4 (lambda (x_0) (unsafe-string-length x_0))) - (procz3 (lambda (x_0) (string? x_0))) - (procz2 (lambda (x_0) (unsafe-string-length x_0))) - (procz1 (lambda (x_0) (string? x_0)))) - (lambda (str_0 start_0 end_0) - (let ((len_0 (* 4 (- end_0 start_0)))) - (let ((bstr_0 (make-bytes len_0))) - (begin - (if (system-big-endian?) - (begin - (call-with-values - (lambda () - (normalise-inputs - 'in-string - "string" - procz1 - procz2 - str_0 - start_0 - end_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (let ((start_1 0)) - (let ((end_1 len_0)) - (let ((inc_0 4)) - (let ((end_2 end_1) - (start_2 start_1) - (v*_1 v*_0) - (start*_1 start*_0) - (stop*_1 stop*_0) - (step*_1 step*_0)) - (begin - #t - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0 pos_0) - (begin - (if (if (unsafe-fx< idx_0 stop*_1) - (< pos_0 end_2) - #f) - (let ((c_0 (string-ref v*_1 idx_0))) - (begin - (let ((n_0 (char->integer c_0))) - (begin - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) + (lambda (str_0 start_0 end_0) + (let ((len_0 (* 4 (- end_0 start_0)))) + (let ((bstr_0 (make-bytes len_0))) + (begin + (if (system-big-endian?) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-string-length + str_0 + start_0 + end_0 + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (let ((start_1 0)) + (let ((end_1 len_0)) + (let ((inc_0 4)) + (let ((end_2 end_1) + (start_2 start_1) + (v*_1 v*_0) + (start*_1 start*_0) + (stop*_1 stop*_0) + (step*_1 step*_0)) + (begin + #t + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0 pos_0) + (begin + (if (if (unsafe-fx< idx_0 stop*_1) + (< pos_0 end_2) + #f) + (let ((c_0 (string-ref v*_1 idx_0))) + (begin + (let ((n_0 (char->integer c_0))) + (begin + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (unsafe-bytes-set! + app_0 + pos_0 + (arithmetic-shift n_0 -24))) + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (let ((app_1 (+ pos_0 1))) (unsafe-bytes-set! app_0 - pos_0 - (arithmetic-shift n_0 -24))) - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) - (let ((app_1 (+ pos_0 1))) - (unsafe-bytes-set! - app_0 - app_1 - (bitwise-and - 255 - (arithmetic-shift - n_0 - -16))))) - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) - (let ((app_1 (+ pos_0 2))) - (unsafe-bytes-set! - app_0 - app_1 - (bitwise-and - 255 - (arithmetic-shift - n_0 - -8))))) - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) - (let ((app_1 (+ pos_0 3))) - (unsafe-bytes-set! - app_0 - app_1 - (bitwise-and 255 n_0)))))) - (for-loop_0 - (unsafe-fx+ idx_0 1) - (+ pos_0 inc_0)))) - (values))))))) - (for-loop_0 start*_1 start_2)))))))) - (args (raise-binding-result-arity-error 4 args)))) - (void)) - (begin - (call-with-values - (lambda () - (normalise-inputs - 'in-string - "string" - procz3 - procz4 - str_0 - start_0 - end_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (let ((start_1 0)) - (let ((end_1 len_0)) - (let ((inc_0 4)) - (let ((end_2 end_1) - (start_2 start_1) - (v*_1 v*_0) - (start*_1 start*_0) - (stop*_1 stop*_0) - (step*_1 step*_0)) - (begin - #t - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (idx_0 pos_0) - (begin - (if (if (unsafe-fx< idx_0 stop*_1) - (< pos_0 end_2) - #f) - (let ((c_0 (string-ref v*_1 idx_0))) - (begin - (let ((n_0 (char->integer c_0))) - (begin - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) - (let ((app_1 (+ pos_0 3))) - (unsafe-bytes-set! - app_0 - app_1 - (arithmetic-shift - n_0 - -24)))) - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) - (let ((app_1 (+ pos_0 2))) - (unsafe-bytes-set! - app_0 - app_1 - (bitwise-and - 255 - (arithmetic-shift - n_0 - -16))))) - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) - (let ((app_1 (+ pos_0 1))) - (unsafe-bytes-set! - app_0 - app_1 - (bitwise-and - 255 - (arithmetic-shift - n_0 - -8))))) - (let ((app_0 - (check-not-unsafe-undefined - bstr_0 - 'bstr_119))) + app_1 + (bitwise-and + 255 + (arithmetic-shift + n_0 + -16))))) + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (let ((app_1 (+ pos_0 2))) (unsafe-bytes-set! app_0 - pos_0 - (bitwise-and 255 n_0))))) - (for-loop_0 - (unsafe-fx+ idx_0 1) - (+ pos_0 inc_0)))) - (values))))))) - (for-loop_0 start*_1 start_2)))))))) - (args (raise-binding-result-arity-error 4 args)))) - (void))) - (check-not-unsafe-undefined bstr_0 'bstr_119))))))) + app_1 + (bitwise-and + 255 + (arithmetic-shift + n_0 + -8))))) + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (let ((app_1 (+ pos_0 3))) + (unsafe-bytes-set! + app_0 + app_1 + (bitwise-and 255 n_0)))))) + (for-loop_0 + (unsafe-fx+ idx_0 1) + (+ pos_0 inc_0)))) + (values))))))) + (for-loop_0 start*_1 start_2)))))))) + (args (raise-binding-result-arity-error 4 args)))) + (void)) + (begin + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-string-length + str_0 + start_0 + end_0 + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (let ((start_1 0)) + (let ((end_1 len_0)) + (let ((inc_0 4)) + (let ((end_2 end_1) + (start_2 start_1) + (v*_1 v*_0) + (start*_1 start*_0) + (stop*_1 stop*_0) + (step*_1 step*_0)) + (begin + #t + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (idx_0 pos_0) + (begin + (if (if (unsafe-fx< idx_0 stop*_1) + (< pos_0 end_2) + #f) + (let ((c_0 (string-ref v*_1 idx_0))) + (begin + (let ((n_0 (char->integer c_0))) + (begin + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (let ((app_1 (+ pos_0 3))) + (unsafe-bytes-set! + app_0 + app_1 + (arithmetic-shift n_0 -24)))) + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (let ((app_1 (+ pos_0 2))) + (unsafe-bytes-set! + app_0 + app_1 + (bitwise-and + 255 + (arithmetic-shift + n_0 + -16))))) + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (let ((app_1 (+ pos_0 1))) + (unsafe-bytes-set! + app_0 + app_1 + (bitwise-and + 255 + (arithmetic-shift + n_0 + -8))))) + (let ((app_0 + (check-not-unsafe-undefined + bstr_0 + 'bstr_119))) + (unsafe-bytes-set! + app_0 + pos_0 + (bitwise-and 255 n_0))))) + (for-loop_0 + (unsafe-fx+ idx_0 1) + (+ pos_0 inc_0)))) + (values))))))) + (for-loop_0 start*_1 start_2)))))))) + (args (raise-binding-result-arity-error 4 args)))) + (void))) + (check-not-unsafe-undefined bstr_0 'bstr_119)))))) (define struct:cache (make-record-type-descriptor* 'cache #f #f #f #f 4 15)) (define effect_2666 (struct-type-install-properties! @@ -18324,8 +18288,7 @@ "LPT8" "LPT9")) (define special-filename?.1 - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) + (letrec () (|#%name| special-filename? (lambda (immediate?1_0 in-bstr3_0) @@ -18514,11 +18477,8 @@ or-part_2 (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-bytes-length (unsafe-unbox* bstr_0) fn-len_0 @@ -18862,9 +18822,7 @@ clean-start-pos_0 #vu8(92 92)))))))))))))))))) (define parse-unc.1 - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0))) - (is-a-sep?_0 + (letrec ((is-a-sep?_0 (|#%name| is-a-sep? (lambda (no-forward-slash?6_0 c_0) @@ -18979,11 +18937,8 @@ or-part_0 (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-bytes-length bstr9_0 (add1 j_5) @@ -24827,81 +24782,60 @@ (|#%app| path-bytes p_0) (1/string->bytes/locale p_0 63)))))) (define just-separators-after? - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0 drive-len_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - drive-len_0 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) - (let ((result_1 - (let ((result_1 (is-sep? b_0 'windows))) - (values result_1)))) - (if (if (not (let ((x_0 (list b_0))) (not result_1))) + (lambda (bstr_0 drive-len_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs unsafe-bytes-length bstr_0 drive-len_0 #f 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) + (let ((result_1 + (let ((result_1 (is-sep? b_0 'windows))) + (values result_1)))) + (if (if (not (let ((x_0 (list b_0))) (not result_1))) + #t + #f) + (for-loop_0 result_1 (unsafe-fx+ idx_0 1)) + result_1))) + result_0)))))) + (for-loop_0 #t start*_0)))) + (args (raise-binding-result-arity-error 4 args)))))) +(define just-backslashes-after? + (lambda (bstr_0 drive-len_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs unsafe-bytes-length bstr_0 drive-len_0 #f 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) + (let ((result_1 (eqv? b_0 92))) + (let ((result_2 (values result_1))) + (if (if (not (let ((x_0 (list b_0))) (not result_2))) #t #f) - (for-loop_0 result_1 (unsafe-fx+ idx_0 1)) - result_1))) - result_0)))))) - (for-loop_0 #t start*_0)))) - (args (raise-binding-result-arity-error 4 args))))))) -(define just-backslashes-after? - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0 drive-len_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - drive-len_0 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) - (let ((result_1 (eqv? b_0 92))) - (let ((result_2 (values result_1))) - (if (if (not - (let ((x_0 (list b_0))) (not result_2))) - #t - #f) - (for-loop_0 result_2 (unsafe-fx+ idx_0 1)) - result_2)))) - result_0)))))) - (for-loop_0 #t start*_0)))) - (args (raise-binding-result-arity-error 4 args))))))) + (for-loop_0 result_2 (unsafe-fx+ idx_0 1)) + result_2)))) + result_0)))))) + (for-loop_0 #t start*_0)))) + (args (raise-binding-result-arity-error 4 args)))))) (define drive? (lambda (s_0) (if (starting-point? s_0) @@ -25730,9 +25664,7 @@ 0))))))) (void)))))))) (define clean-double-slashes.1 - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0))) - (is-a-sep?_0 + (letrec ((is-a-sep?_0 (|#%name| is-a-sep? (lambda (convention6_0 only-backslash?1_0 b_0) @@ -25858,11 +25790,8 @@ (not (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-bytes-length bstr5_0 to-backslash-from2_0 #f @@ -32162,110 +32091,103 @@ ((bstr_0) (begin (bytes->path-element_0 bstr_0 unsafe-undefined))) ((bstr_0 convention3_0) (bytes->path-element_0 bstr_0 convention3_0)))))) (define path-element-clean.1 - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (|#%name| - path-element-clean - (lambda (try-quick?5_0 p7_0) - (begin - (if (1/path? p7_0) - (let ((bstr_0 (|#%app| path-bytes p7_0))) - (let ((convention_0 (|#%app| path-convention p7_0))) - (if (let ((or-part_0 (not try-quick?5_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (not (eq? convention_0 'unix)))) - (if or-part_1 - or-part_1 - (not - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - 0 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (end_0) - (begin - (if (zero? end_0) - 0 - (if (is-sep? - (unsafe-bytes-ref - bstr_0 - (sub1 end_0)) - convention_0) - (loop_0 (sub1 end_0)) - end_0))))))) - (loop_0 (unsafe-bytes-length bstr_0))) - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (let ((start_0 0)) - (let ((v*_1 v*_0) - (start*_1 start*_0) - (stop*_1 stop*_0) - (step*_1 step*_0)) - (begin - #t - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 pos_0) - (begin - (if (if (unsafe-fx< idx_0 stop*_1) - #t - #f) - (let ((c_0 - (unsafe-bytes-ref - v*_1 - idx_0))) - (let ((result_1 - (let ((result_1 - (if (is-sep? - c_0 - convention_0) - pos_0 - #f))) - (values result_1)))) - (if (if (not + (|#%name| + path-element-clean + (lambda (try-quick?5_0 p7_0) + (begin + (if (1/path? p7_0) + (let ((bstr_0 (|#%app| path-bytes p7_0))) + (let ((convention_0 (|#%app| path-convention p7_0))) + (if (let ((or-part_0 (not try-quick?5_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 (not (eq? convention_0 'unix)))) + (if or-part_1 + or-part_1 + (not + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + bstr_0 + 0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (end_0) + (begin + (if (zero? end_0) + 0 + (if (is-sep? + (unsafe-bytes-ref + bstr_0 + (sub1 end_0)) + convention_0) + (loop_0 (sub1 end_0)) + end_0))))))) + (loop_0 (unsafe-bytes-length bstr_0))) + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (let ((start_0 0)) + (let ((v*_1 v*_0) + (start*_1 start*_0) + (stop*_1 stop*_0) + (step*_1 step*_0)) + (begin + #t + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 pos_0) + (begin + (if (if (unsafe-fx< idx_0 stop*_1) + #t + #f) + (let ((c_0 + (unsafe-bytes-ref + v*_1 + idx_0))) + (let ((result_1 + (let ((result_1 + (if (is-sep? + c_0 + convention_0) + pos_0 + #f))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list c_0))) + result_1)) + (if (not (let ((x_0 - (list c_0))) + (list + pos_0))) result_1)) - (if (not - (let ((x_0 - (list - pos_0))) - result_1)) - #t - #f) + #t #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (+ pos_0 1)) - result_1))) - result_0)))))) - (for-loop_0 #f start*_1 start_0)))))) - (args - (raise-binding-result-arity-error - 4 - args))))))))) - (call-with-values - (lambda () (1/split-path p7_0)) - (case-lambda - ((base_0 name_0 dir?_0) - (if (symbol? base_0) (if (1/path? name_0) name_0 #f) #f)) - (args (raise-binding-result-arity-error 3 args)))) - #f))) - #f)))))) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (+ pos_0 1)) + result_1))) + result_0)))))) + (for-loop_0 #f start*_1 start_0)))))) + (args + (raise-binding-result-arity-error 4 args))))))))) + (call-with-values + (lambda () (1/split-path p7_0)) + (case-lambda + ((base_0 name_0 dir?_0) + (if (symbol? base_0) (if (1/path? name_0) name_0 #f) #f)) + (args (raise-binding-result-arity-error 3 args)))) + #f))) + #f))))) (define path-element? (lambda (p_0) (if (path-element-clean.1 #t p_0) #t #f))) (define do-bytes->path-element (letrec ((bad-element_0 @@ -32433,8 +32355,8 @@ (let ((c_0 (string-ref vec_0 pos_0))) (let ((n_1 (let ((n_1 - (if (>= (char->integer c_0) 65536) - (add1 n_0) + (if (fx>= (char->integer c_0) 65536) + (fx+ n_0 1) n_0))) (values n_1)))) (for-loop_0 n_1 (unsafe-fx+ 1 pos_0)))) @@ -32442,7 +32364,7 @@ (for-loop_0 0 0)))) (args (raise-binding-result-arity-error 2 args)))))) (let ((bstr_0 - (make-bytes (* 2 (+ (string-length s_0) surrogate-count_0))))) + (make-bytes (fx* 2 (fx+ (string-length s_0) surrogate-count_0))))) (begin (call-with-values (lambda () @@ -32464,57 +32386,42 @@ (let ((pos_2 (let ((pos_2 (let ((v_0 (char->integer c_0))) - (if (>= v_0 65536) - (let ((av_0 (- v_0 65536))) + (if (fx>= v_0 65536) + (let ((av_0 (fx- v_0 65536))) (let ((hi_0 - (bitwise-ior + (fxior 55296 - (bitwise-and - (arithmetic-shift - av_0 - -10) + (fxand + (fxrshift av_0 10) 1023)))) (let ((lo_0 - (bitwise-ior + (fxior 56320 - (bitwise-and - av_0 - 1023)))) + (fxand av_0 1023)))) (begin (let ((app_0 - (arithmetic-shift - hi_0 - -8))) + (fxrshift hi_0 8))) (bytes-set-two! bstr_0 pos_0 app_0 - (bitwise-and - hi_0 - 255))) + (fxand hi_0 255))) (let ((app_0 - (arithmetic-shift - lo_0 - -8))) + (fxrshift lo_0 8))) (bytes-set-two! bstr_0 pos_0 app_0 - (bitwise-and - lo_0 - 255))) - (+ pos_0 4))))) + (fxand lo_0 255))) + (fx+ pos_0 4))))) (begin - (let ((app_0 - (arithmetic-shift - v_0 - -8))) + (let ((app_0 (fxrshift v_0 8))) (bytes-set-two! bstr_0 pos_0 app_0 - (bitwise-and v_0 255))) - (+ pos_0 2)))))) + (fxand v_0 255))) + (fx+ pos_0 2)))))) (values pos_2)))) (for-loop_0 pos_2 (unsafe-fx+ 1 pos_1)))) pos_0)))))) @@ -32523,104 +32430,89 @@ bstr_0))))) (define big-endian? (system-big-endian?)) (define utf-16-decode - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0) - (let ((len_0 (unsafe-bytes-length bstr_0))) - (let ((surrogate-count_0 - (if (= len_0 0) - 0 - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - (if big-endian? 0 1) - len_0 - 2)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (n_0 idx_0) - (begin - (if (< idx_0 stop*_0) - (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) - (let ((n_1 - (let ((n_1 - (if (= - (bitwise-and b_0 220) - 216) - (add1 n_0) - n_0))) - (values n_1)))) - (for-loop_0 n_1 (+ idx_0 2)))) - n_0)))))) - (for-loop_0 0 start*_0)))) - (args (raise-binding-result-arity-error 4 args))))))) - (let ((str_0 - (make-string - (- (arithmetic-shift len_0 -1) surrogate-count_0)))) - (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (i_0 pos_0) - (begin - (if (= i_0 len_0) - (void) - (let ((a_0 (unsafe-bytes-ref bstr_0 i_0))) - (let ((b_0 (unsafe-bytes-ref bstr_0 (add1 i_0)))) - (let ((v_0 - (if big-endian? - (bitwise-ior (arithmetic-shift a_0 8) b_0) - (bitwise-ior - (arithmetic-shift b_0 8) - a_0)))) - (if (= (bitwise-and v_0 56320) 56320) - (let ((a_1 - (unsafe-bytes-ref bstr_0 (+ i_0 2)))) - (let ((b_1 - (unsafe-bytes-ref bstr_0 (+ i_0 3)))) - (let ((v2_0 - (if big-endian? - (bitwise-ior - (arithmetic-shift a_1 8) - b_1) - (bitwise-ior - (arithmetic-shift b_1 8) - a_1)))) - (let ((all-v_0 - (+ - 65536 - (let ((app_0 - (arithmetic-shift - (bitwise-and v_0 1023) - 10))) - (bitwise-ior - app_0 - (bitwise-and v2_0 1023)))))) - (begin - (string-set! - str_0 - pos_0 - (integer->char all-v_0)) - (let ((app_0 (+ i_0 4))) - (loop_0 app_0 (add1 pos_0)))))))) - (begin - (string-set! str_0 pos_0 (integer->char v_0)) - (let ((app_0 (+ i_0 2))) - (loop_0 app_0 (add1 pos_0)))))))))))))) - (loop_0 0 0)) - str_0))))))) + (lambda (bstr_0) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (let ((surrogate-count_0 + (if (fx= len_0 0) + 0 + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + bstr_0 + (if big-endian? 0 1) + len_0 + 2)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (n_0 idx_0) + (begin + (if (< idx_0 stop*_0) + (let ((b_0 (unsafe-bytes-ref v*_0 idx_0))) + (let ((n_1 + (let ((n_1 + (if (fx= (fxand b_0 220) 216) + (fx+ n_0 1) + n_0))) + (values n_1)))) + (for-loop_0 n_1 (+ idx_0 2)))) + n_0)))))) + (for-loop_0 0 start*_0)))) + (args (raise-binding-result-arity-error 4 args))))))) + (let ((str_0 (make-string (fx- (fxrshift len_0 1) surrogate-count_0)))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 pos_0) + (begin + (if (fx= i_0 len_0) + (void) + (let ((a_0 (unsafe-bytes-ref bstr_0 i_0))) + (let ((b_0 (unsafe-bytes-ref bstr_0 (fx+ i_0 1)))) + (let ((v_0 + (if big-endian? + (fxior (fxlshift a_0 8) b_0) + (fxior (fxlshift b_0 8) a_0)))) + (if (fx= (fxand v_0 56320) 56320) + (let ((a_1 + (unsafe-bytes-ref bstr_0 (fx+ i_0 2)))) + (let ((b_1 + (unsafe-bytes-ref bstr_0 (fx+ i_0 3)))) + (let ((v2_0 + (if big-endian? + (fxior (fxlshift a_1 8) b_1) + (fxior (fxlshift b_1 8) a_1)))) + (let ((all-v_0 + (fx+ + 65536 + (let ((app_0 + (fxlshift + (fxand v_0 1023) + 10))) + (fxior + app_0 + (fxand v2_0 1023)))))) + (begin + (string-set! + str_0 + pos_0 + (integer->char all-v_0)) + (let ((app_0 (fx+ i_0 4))) + (loop_0 app_0 (fx+ pos_0 1)))))))) + (begin + (string-set! str_0 pos_0 (integer->char v_0)) + (let ((app_0 (fx+ i_0 2))) + (loop_0 app_0 (fx+ pos_0 1)))))))))))))) + (loop_0 0 0)) + str_0)))))) (define string-length-up-to-nul (lambda (s_0 i_0 l_0) (letrec* @@ -32664,8 +32556,10 @@ (lambda (len_0 s3_0 up?1_0 pos_0) (begin (let ((i-len_0 - (+ pos_0 (string-length-up-to-nul s3_0 pos_0 len_0)))) - (if (= i-len_0 len_0) + (fx+ + pos_0 + (string-length-up-to-nul s3_0 pos_0 len_0)))) + (if (fx= i-len_0 len_0) (let ((new-s_0 (recase/no-nul (if (zero? pos_0) @@ -32677,7 +32571,7 @@ (recase/no-nul (substring s3_0 pos_0 i-len_0) up?1_0))) - (let ((r_0 (loop_0 len_0 s3_0 up?1_0 (+ i-len_0 1)))) + (let ((r_0 (loop_0 len_0 s3_0 up?1_0 (fx+ i-len_0 1)))) (if (eqv? pos_0 0) (apply string-append new-s_0 (string '#\x0) r_0) (cons new-s_0 (cons (string '#\x0) r_0)))))))))))) @@ -32692,7 +32586,7 @@ loop (lambda (c_0 in-bstr_0 s_0 up?_0 pos_0) (begin - (if (= pos_0 (unsafe-bytes-length in-bstr_0)) + (if (fx= pos_0 (unsafe-bytes-length in-bstr_0)) (if (eqv? pos_0 0) "" '("")) (call-with-values (lambda () @@ -32715,14 +32609,14 @@ in-bstr_0 s_0 up?_0 - (+ pos_0 in-used_0 4)))) + (fx+ pos_0 in-used_0 4)))) (let ((err-s_0 (string (string-ref s_0 - (arithmetic-shift + (fxrshift (+ pos_0 in-used_0) - -2))))) + 2))))) (if (eqv? pos_0 0) (apply string-append ls_0 err-s_0 r_0) (list* ls_0 err-s_0 r_0))))))))))) @@ -32731,7 +32625,7 @@ (if (if (equal? (1/current-locale) "") (not (zero? - (bitwise-and + (fxand (|#%app| rktio_convert_properties (unsafe-place-local-ref cell.1)) @@ -32746,7 +32640,7 @@ (unsafe-place-local-ref cell.1) up?_0 s-16_0 - (arithmetic-shift (unsafe-bytes-length s-16_0) -1) + (fxrshift (unsafe-bytes-length s-16_0) 1) #f))) (let ((sr_0 (|#%app| rktio_to_shorts r_0))) (begin @@ -36010,11 +35904,11 @@ 'subprocess "(or/c (and/c output-port? file-stream-port?) #f 'stdout)" stderr_0)) - (let ((lr3728 unsafe-undefined) + (let ((lr3736 unsafe-undefined) (group_0 unsafe-undefined) (command_0 unsafe-undefined) (exact/args_0 unsafe-undefined)) - (set! lr3728 + (set! lr3736 (call-with-values (lambda () (if (path-string? group/command_0) @@ -36069,9 +35963,9 @@ ((group_1 command_1 exact/args_1) (vector group_1 command_1 exact/args_1)) (args (raise-binding-result-arity-error 3 args))))) - (set! group_0 (unsafe-vector*-ref lr3728 0)) - (set! command_0 (unsafe-vector*-ref lr3728 1)) - (set! exact/args_0 (unsafe-vector*-ref lr3728 2)) + (set! group_0 (unsafe-vector*-ref lr3736 0)) + (set! command_0 (unsafe-vector*-ref lr3736 1)) + (set! exact/args_0 (unsafe-vector*-ref lr3736 2)) (call-with-values (lambda () (if (if (pair? exact/args_0) diff --git a/racket/src/cs/schemified/regexp.scm b/racket/src/cs/schemified/regexp.scm index 7605675bfd..252048185a 100644 --- a/racket/src/cs/schemified/regexp.scm +++ b/racket/src/cs/schemified/regexp.scm @@ -483,6 +483,13 @@ (begin (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0) (values vec_0 start_0 stop*_0 step_0))))))) +(define unsafe-normalise-inputs + (lambda (unsafe-vector-length_0 vec_0 start_0 stop_0 step_0) + (values + vec_0 + start_0 + (if stop_0 stop_0 (|#%app| unsafe-vector-length_0 vec_0)) + step_0))) (define check-vector (lambda (v_0) (if (vector? v_0) (void) (raise-argument-error 'in-vector "vector" v_0)))) @@ -4556,42 +4563,31 @@ (define FFFF-tails '#(#vu8() #vu8(255) #vu8(255 255) #vu8(255 255 255) #vu8(255 255 255 255))) (define 0000-tails '#(#vu8() #vu8(0) #vu8(0 0) #vu8(0 0 0) #vu8(0 0 0 0))) (define zero-tail? - (letrec ((procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0 i_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - i_0 - #f - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((c_0 (unsafe-bytes-ref v*_0 idx_0))) - (let ((result_1 - (let ((result_1 (= c_0 0))) (values result_1)))) - (if (if (not (let ((x_0 (list c_0))) (not result_1))) - #t - #f) - (for-loop_0 result_1 (unsafe-fx+ idx_0 1)) - result_1))) - result_0)))))) - (for-loop_0 #t start*_0)))) - (args (raise-binding-result-arity-error 4 args))))))) + (lambda (bstr_0 i_0) + (call-with-values + (lambda () (unsafe-normalise-inputs unsafe-bytes-length bstr_0 i_0 #f 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((c_0 (unsafe-bytes-ref v*_0 idx_0))) + (let ((result_1 + (let ((result_1 (= c_0 0))) (values result_1)))) + (if (if (not (let ((x_0 (list c_0))) (not result_1))) + #t + #f) + (for-loop_0 result_1 (unsafe-fx+ idx_0 1)) + result_1))) + result_0)))))) + (for-loop_0 #t start*_0)))) + (args (raise-binding-result-arity-error 4 args)))))) (define anchored? (lambda (rx_0) (if (eq? rx_0 'start) @@ -5542,528 +5538,464 @@ (let ((app_0 (+ pos_1 1))) (loop_0 app_0 (add1 n_0))))))))) (loop_0 pos_0 0))))))) (define bytes-matcher - (letrec ((procz6 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz5 (lambda (x_0) (bytes? x_0))) - (procz4 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz3 (lambda (x_0) (bytes? x_0))) - (procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0 len_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (if (if (bytes? s_0) - (if (<= (+ pos_0 len_0) limit_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - 0 - len_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz3 - procz4 - s_0 - pos_0 - (+ pos_0 len_0) - 1)) - (case-lambda - ((v*_1 start*_1 stop*_1 step*_1) - (let ((v*_2 v*_0) - (start*_2 start*_0) - (stop*_2 stop*_0) - (step*_2 step*_0)) - (begin - #t - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 idx_1) - (begin - (if (if (unsafe-fx< idx_0 stop*_2) - (unsafe-fx< idx_1 stop*_1) - #f) - (let ((c1_0 (unsafe-bytes-ref v*_2 idx_0))) - (let ((c2_0 - (unsafe-bytes-ref v*_1 idx_1))) - (let ((c1_1 c1_0)) - (let ((result_1 - (let ((result_1 - (= c1_1 c2_0))) - (values result_1)))) - (if (if (not - (let ((x_0 (list c1_1))) - (not result_1))) - (if (not - (let ((x_0 (list c2_0))) - (not result_1))) - #t - #f) - #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (unsafe-fx+ idx_1 1)) - result_1))))) - result_0)))))) - (for-loop_0 #t start*_2 start*_1))))) - (args (raise-binding-result-arity-error 4 args))))) - (args (raise-binding-result-arity-error 4 args)))) - #f) + (lambda (bstr_0 len_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (if (if (bytes? s_0) + (if (<= (+ pos_0 len_0) limit_0) (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz5 - procz6 + (unsafe-normalise-inputs + unsafe-bytes-length bstr_0 0 len_0 1)) (case-lambda ((v*_0 start*_0 stop*_0 step*_0) - (let ((start_1 pos_0)) - (let ((v*_1 v*_0) - (start*_1 start*_0) - (stop*_1 stop*_0) - (step*_1 step*_0)) - (begin - #t - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 pos_1) - (begin - (if (if (unsafe-fx< idx_0 stop*_1) #t #f) - (let ((c1_0 (unsafe-bytes-ref v*_1 idx_0))) - (let ((result_1 - (let ((result_1 - (if (lazy-bytes-before-end? - s_0 - pos_1 - limit_0) - (let ((c2_0 - (lazy-bytes-ref - s_0 - pos_1))) - (= c1_0 c2_0)) - #f))) - (values result_1)))) - (if (if (not - (let ((x_0 (list c1_0))) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + pos_0 + (+ pos_0 len_0) + 1)) + (case-lambda + ((v*_1 start*_1 stop*_1 step*_1) + (let ((v*_2 v*_0) + (start*_2 start*_0) + (stop*_2 stop*_0) + (step*_2 step*_0)) + (begin + #t + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 idx_1) + (begin + (if (if (unsafe-fx< idx_0 stop*_2) + (unsafe-fx< idx_1 stop*_1) + #f) + (let ((c1_0 (unsafe-bytes-ref v*_2 idx_0))) + (let ((c2_0 (unsafe-bytes-ref v*_1 idx_1))) + (let ((c1_1 c1_0)) + (let ((result_1 + (let ((result_1 (= c1_1 c2_0))) + (values result_1)))) + (if (if (not + (let ((x_0 (list c1_1))) + (not result_1))) + (if (not + (let ((x_0 (list c2_0))) + (not result_1))) + #t + #f) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (unsafe-fx+ idx_1 1)) + result_1))))) + result_0)))))) + (for-loop_0 #t start*_2 start*_1))))) + (args (raise-binding-result-arity-error 4 args))))) + (args (raise-binding-result-arity-error 4 args)))) + #f) + (call-with-values + (lambda () + (unsafe-normalise-inputs unsafe-bytes-length bstr_0 0 len_0 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (let ((start_1 pos_0)) + (let ((v*_1 v*_0) + (start*_1 start*_0) + (stop*_1 stop*_0) + (step*_1 step*_0)) + (begin + #t + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 pos_1) + (begin + (if (if (unsafe-fx< idx_0 stop*_1) #t #f) + (let ((c1_0 (unsafe-bytes-ref v*_1 idx_0))) + (let ((result_1 + (let ((result_1 + (if (lazy-bytes-before-end? + s_0 + pos_1 + limit_0) + (let ((c2_0 + (lazy-bytes-ref + s_0 + pos_1))) + (= c1_0 c2_0)) + #f))) + (values result_1)))) + (if (if (not + (let ((x_0 (list c1_0))) + (not result_1))) + (if (not + (let ((x_0 (list pos_1))) (not result_1))) - (if (not - (let ((x_0 (list pos_1))) - (not result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (+ pos_1 1)) - result_1))) - result_0)))))) - (for-loop_0 #t start*_1 start_1)))))) - (args (raise-binding-result-arity-error 4 args))))) - (|#%app| - next-m_0 - s_0 - (+ pos_0 len_0) - start_0 - limit_0 - end_0 - state_0 - stack_0) - #f))))) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (+ pos_1 1)) + result_1))) + result_0)))))) + (for-loop_0 #t start*_1 start_1)))))) + (args (raise-binding-result-arity-error 4 args))))) + (|#%app| + next-m_0 + s_0 + (+ pos_0 len_0) + start_0 + limit_0 + end_0 + state_0 + stack_0) + #f)))) (define bytes-tail-matcher - (letrec ((procz6 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz5 (lambda (x_0) (bytes? x_0))) - (procz4 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz3 (lambda (x_0) (bytes? x_0))) - (procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0 len_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (if (if (bytes? s_0) - (if (<= (+ pos_0 len_0) limit_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - bstr_0 - 0 - len_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz3 - procz4 - s_0 - pos_0 - (+ pos_0 len_0) - 1)) - (case-lambda - ((v*_1 start*_1 stop*_1 step*_1) - (let ((v*_2 v*_0) - (start*_2 start*_0) - (stop*_2 stop*_0) - (step*_2 step*_0)) - (begin - #t - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 idx_1) - (begin - (if (if (unsafe-fx< idx_0 stop*_2) - (unsafe-fx< idx_1 stop*_1) - #f) - (let ((c1_0 (unsafe-bytes-ref v*_2 idx_0))) - (let ((c2_0 - (unsafe-bytes-ref v*_1 idx_1))) - (let ((c1_1 c1_0)) - (let ((result_1 - (let ((result_1 - (= c1_1 c2_0))) - (values result_1)))) - (if (if (not - (let ((x_0 (list c1_1))) - (not result_1))) - (if (not - (let ((x_0 (list c2_0))) - (not result_1))) - #t - #f) - #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (unsafe-fx+ idx_1 1)) - result_1))))) - result_0)))))) - (for-loop_0 #t start*_2 start*_1))))) - (args (raise-binding-result-arity-error 4 args))))) - (args (raise-binding-result-arity-error 4 args)))) - #f) + (lambda (bstr_0 len_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (if (if (bytes? s_0) + (if (<= (+ pos_0 len_0) limit_0) (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz5 - procz6 + (unsafe-normalise-inputs + unsafe-bytes-length bstr_0 0 len_0 1)) (case-lambda ((v*_0 start*_0 stop*_0 step*_0) - (let ((start_1 pos_0)) - (let ((v*_1 v*_0) - (start*_1 start*_0) - (stop*_1 stop*_0) - (step*_1 step*_0)) - (begin - #t - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 pos_1) - (begin - (if (if (unsafe-fx< idx_0 stop*_1) #t #f) - (let ((c1_0 (unsafe-bytes-ref v*_1 idx_0))) - (let ((result_1 - (let ((result_1 - (if (lazy-bytes-before-end? - s_0 - pos_1 - limit_0) - (let ((c2_0 - (lazy-bytes-ref - s_0 - pos_1))) - (= c1_0 c2_0)) - #f))) - (values result_1)))) - (if (if (not - (let ((x_0 (list c1_0))) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + pos_0 + (+ pos_0 len_0) + 1)) + (case-lambda + ((v*_1 start*_1 stop*_1 step*_1) + (let ((v*_2 v*_0) + (start*_2 start*_0) + (stop*_2 stop*_0) + (step*_2 step*_0)) + (begin + #t + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 idx_1) + (begin + (if (if (unsafe-fx< idx_0 stop*_2) + (unsafe-fx< idx_1 stop*_1) + #f) + (let ((c1_0 (unsafe-bytes-ref v*_2 idx_0))) + (let ((c2_0 (unsafe-bytes-ref v*_1 idx_1))) + (let ((c1_1 c1_0)) + (let ((result_1 + (let ((result_1 (= c1_1 c2_0))) + (values result_1)))) + (if (if (not + (let ((x_0 (list c1_1))) + (not result_1))) + (if (not + (let ((x_0 (list c2_0))) + (not result_1))) + #t + #f) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (unsafe-fx+ idx_1 1)) + result_1))))) + result_0)))))) + (for-loop_0 #t start*_2 start*_1))))) + (args (raise-binding-result-arity-error 4 args))))) + (args (raise-binding-result-arity-error 4 args)))) + #f) + (call-with-values + (lambda () + (unsafe-normalise-inputs unsafe-bytes-length bstr_0 0 len_0 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (let ((start_1 pos_0)) + (let ((v*_1 v*_0) + (start*_1 start*_0) + (stop*_1 stop*_0) + (step*_1 step*_0)) + (begin + #t + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 pos_1) + (begin + (if (if (unsafe-fx< idx_0 stop*_1) #t #f) + (let ((c1_0 (unsafe-bytes-ref v*_1 idx_0))) + (let ((result_1 + (let ((result_1 + (if (lazy-bytes-before-end? + s_0 + pos_1 + limit_0) + (let ((c2_0 + (lazy-bytes-ref + s_0 + pos_1))) + (= c1_0 c2_0)) + #f))) + (values result_1)))) + (if (if (not + (let ((x_0 (list c1_0))) + (not result_1))) + (if (not + (let ((x_0 (list pos_1))) (not result_1))) - (if (not - (let ((x_0 (list pos_1))) - (not result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (+ pos_1 1)) - result_1))) - result_0)))))) - (for-loop_0 #t start*_1 start_1)))))) - (args (raise-binding-result-arity-error 4 args))))) - (+ pos_0 len_0) - #f))))) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (+ pos_1 1)) + result_1))) + result_0)))))) + (for-loop_0 #t start*_1 start_1)))))) + (args (raise-binding-result-arity-error 4 args))))) + (+ pos_0 len_0) + #f)))) (define bytes-matcher* - (letrec ((procz6 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz5 (lambda (x_0) (bytes? x_0))) - (procz4 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz3 (lambda (x_0) (bytes? x_0))) - (procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (bstr_0 max_0) - (let ((len_0 (unsafe-bytes-length bstr_0))) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0) - (if (bytes? s_0) - (let ((limit_1 - (if max_0 (min limit_0 (+ pos_0 (* len_0 max_0))) limit_0))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (pos_1 n_0) - (begin - (let ((pos3_0 (+ pos_1 len_0))) - (if (let ((or-part_0 (> pos3_0 limit_1))) - (if or-part_0 - or-part_0 + (lambda (bstr_0 max_0) + (let ((len_0 (unsafe-bytes-length bstr_0))) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0) + (if (bytes? s_0) + (let ((limit_1 + (if max_0 (min limit_0 (+ pos_0 (* len_0 max_0))) limit_0))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_1 n_0) + (begin + (let ((pos3_0 (+ pos_1 len_0))) + (if (let ((or-part_0 (> pos3_0 limit_1))) + (if or-part_0 + or-part_0 + (not + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + bstr_0 + 0 + len_0 + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + pos_1 + (+ pos_1 len_0) + 1)) + (case-lambda + ((v*_1 start*_1 stop*_1 step*_1) + (let ((v*_2 v*_0) + (start*_2 start*_0) + (stop*_2 stop*_0) + (step*_2 step*_0)) + (begin + #t + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 idx_1) + (begin + (if (if (unsafe-fx< + idx_0 + stop*_2) + (unsafe-fx< + idx_1 + stop*_1) + #f) + (let ((c1_0 + (unsafe-bytes-ref + v*_2 + idx_0))) + (let ((c2_0 + (unsafe-bytes-ref + v*_1 + idx_1))) + (let ((c1_1 c1_0)) + (let ((result_1 + (let ((result_1 + (= + c1_1 + c2_0))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + c1_1))) + (not + result_1))) + (if (not + (let ((x_0 + (list + c2_0))) + (not + result_1))) + #t + #f) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ + idx_0 + 1) + (unsafe-fx+ + idx_1 + 1)) + result_1))))) + result_0)))))) + (for-loop_0 #t start*_2 start*_1))))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (args + (raise-binding-result-arity-error + 4 + args))))))) + (values pos_1 n_0 len_0) + (loop_0 pos3_0 (add1 n_0))))))))) + (loop_0 pos_0 0))) + (let ((limit_1 (if max_0 (+ pos_0 (* len_0 max_0)) #f))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (pos_1 n_0) + (begin + (if (let ((or-part_0 + (if limit_1 (> (+ pos_1 len_0) limit_1) #f))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (not + (lazy-bytes-before-end? + s_0 + pos_1 + limit_1)))) + (if or-part_1 + or-part_1 (not (call-with-values (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-bytes-length bstr_0 0 len_0 1)) (case-lambda ((v*_0 start*_0 stop*_0 step*_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz3 - procz4 - s_0 - pos_1 - (+ pos_1 len_0) - 1)) - (case-lambda - ((v*_1 start*_1 stop*_1 step*_1) - (let ((v*_2 v*_0) - (start*_2 start*_0) - (stop*_2 stop*_0) - (step*_2 step*_0)) - (begin - #t - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 idx_1) - (begin - (if (if (unsafe-fx< - idx_0 - stop*_2) - (unsafe-fx< - idx_1 - stop*_1) - #f) - (let ((c1_0 - (unsafe-bytes-ref - v*_2 - idx_0))) - (let ((c2_0 - (unsafe-bytes-ref - v*_1 - idx_1))) - (let ((c1_1 c1_0)) - (let ((result_1 - (let ((result_1 - (= - c1_1 - c2_0))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - c1_1))) - (not - result_1))) - (if (not - (let ((x_0 - (list - c2_0))) - (not - result_1))) - #t - #f) - #f) - (for-loop_0 - result_1 - (unsafe-fx+ - idx_0 - 1) - (unsafe-fx+ - idx_1 - 1)) - result_1))))) - result_0)))))) - (for-loop_0 - #t - start*_2 - start*_1))))) - (args - (raise-binding-result-arity-error - 4 - args))))) + (let ((start_1 pos_1)) + (let ((v*_1 v*_0) + (start*_1 start*_0) + (stop*_1 stop*_0) + (step*_1 step*_0)) + (begin + #t + (void) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 pos_2) + (begin + (if (if (unsafe-fx< + idx_0 + stop*_1) + #t + #f) + (let ((c1_0 + (unsafe-bytes-ref + v*_1 + idx_0))) + (let ((result_1 + (let ((result_1 + (if (lazy-bytes-before-end? + s_0 + pos_2 + limit_1) + (let ((c2_0 + (lazy-bytes-ref + s_0 + pos_2))) + (= + c1_0 + c2_0)) + #f))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + c1_0))) + (not + result_1))) + (if (not + (let ((x_0 + (list + pos_2))) + (not + result_1))) + #t + #f) + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (+ pos_2 1)) + result_1))) + result_0)))))) + (for-loop_0 + #t + start*_1 + start_1)))))) (args (raise-binding-result-arity-error 4 - args))))))) - (values pos_1 n_0 len_0) - (loop_0 pos3_0 (add1 n_0))))))))) - (loop_0 pos_0 0))) - (let ((limit_1 (if max_0 (+ pos_0 (* len_0 max_0)) #f))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (pos_1 n_0) - (begin - (if (let ((or-part_0 - (if limit_1 (> (+ pos_1 len_0) limit_1) #f))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (not - (lazy-bytes-before-end? - s_0 - pos_1 - limit_1)))) - (if or-part_1 - or-part_1 - (not - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz5 - procz6 - bstr_0 - 0 - len_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (let ((start_1 pos_1)) - (let ((v*_1 v*_0) - (start*_1 start*_0) - (stop*_1 stop*_0) - (step*_1 step*_0)) - (begin - #t - (void) - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 pos_2) - (begin - (if (if (unsafe-fx< - idx_0 - stop*_1) - #t - #f) - (let ((c1_0 - (unsafe-bytes-ref - v*_1 - idx_0))) - (let ((result_1 - (let ((result_1 - (if (lazy-bytes-before-end? - s_0 - pos_2 - limit_1) - (let ((c2_0 - (lazy-bytes-ref - s_0 - pos_2))) - (= - c1_0 - c2_0)) - #f))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - c1_0))) - (not - result_1))) - (if (not - (let ((x_0 - (list - pos_2))) - (not - result_1))) - #t - #f) - #f) - (for-loop_0 - result_1 - (unsafe-fx+ - idx_0 - 1) - (+ pos_2 1)) - result_1))) - result_0)))))) - (for-loop_0 - #t - start*_1 - start_1)))))) - (args - (raise-binding-result-arity-error - 4 - args))))))))) - (values pos_1 n_0 len_0) - (let ((app_0 (+ pos_1 len_0))) - (loop_0 app_0 (add1 n_0))))))))) - (loop_0 pos_0 0))))))))) + args))))))))) + (values pos_1 n_0 len_0) + (let ((app_0 (+ pos_1 len_0))) + (loop_0 app_0 (add1 n_0))))))))) + (loop_0 pos_0 0)))))))) (define never-matcher (letrec ((procz1 (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) #f))) @@ -6741,325 +6673,297 @@ (if state_0 (vector-set! state_0 n_0 old-span_0) (void)) #f))))))))) (define reference-matcher - (letrec ((procz4 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz3 (lambda (x_0) (bytes? x_0))) - (procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (n_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (let ((p_0 (vector-ref state_0 n_0))) - (if (not p_0) - #f - (let ((len_0 (let ((app_0 (cdr p_0))) (- app_0 (car p_0))))) - (let ((matches?_0 - (if (bytes? s_0) - (if (<= (+ pos_0 len_0) limit_0) - (call-with-values - (lambda () - (let ((app_0 (car p_0))) - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - s_0 - app_0 - (cdr p_0) - 1))) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz3 - procz4 - s_0 - pos_0 - (+ pos_0 len_0) - 1)) - (case-lambda - ((v*_1 start*_1 stop*_1 step*_1) - (let ((v*_2 v*_0) - (start*_2 start*_0) - (stop*_2 stop*_0) - (step*_2 step*_0)) - (begin - #t - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 idx_1) - (begin - (if (if (unsafe-fx< idx_0 stop*_2) - (unsafe-fx< idx_1 stop*_1) - #f) - (let ((c1_0 + (lambda (n_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (let ((p_0 (vector-ref state_0 n_0))) + (if (not p_0) + #f + (let ((len_0 (let ((app_0 (cdr p_0))) (- app_0 (car p_0))))) + (let ((matches?_0 + (if (bytes? s_0) + (if (<= (+ pos_0 len_0) limit_0) + (call-with-values + (lambda () + (let ((app_0 (car p_0))) + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + app_0 + (cdr p_0) + 1))) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + pos_0 + (+ pos_0 len_0) + 1)) + (case-lambda + ((v*_1 start*_1 stop*_1 step*_1) + (let ((v*_2 v*_0) + (start*_2 start*_0) + (stop*_2 stop*_0) + (step*_2 step*_0)) + (begin + #t + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 idx_1) + (begin + (if (if (unsafe-fx< idx_0 stop*_2) + (unsafe-fx< idx_1 stop*_1) + #f) + (let ((c1_0 + (unsafe-bytes-ref + v*_2 + idx_0))) + (let ((c2_0 (unsafe-bytes-ref - v*_2 - idx_0))) - (let ((c2_0 - (unsafe-bytes-ref - v*_1 - idx_1))) - (let ((c1_1 c1_0)) - (let ((result_1 - (let ((result_1 - (= - c1_1 - c2_0))) - (values - result_1)))) - (if (if (not + v*_1 + idx_1))) + (let ((c1_1 c1_0)) + (let ((result_1 + (let ((result_1 + (= c1_1 c2_0))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list + c1_1))) + (not result_1))) + (if (not (let ((x_0 (list - c1_1))) + c2_0))) (not result_1))) - (if (not - (let ((x_0 - (list - c2_0))) - (not - result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (unsafe-fx+ idx_1 1)) - result_1))))) - result_0)))))) - (for-loop_0 #t start*_2 start*_1))))) - (args - (raise-binding-result-arity-error 4 args))))) - (args (raise-binding-result-arity-error 4 args)))) - #f) - (let ((start_1 (car p_0))) - (let ((end_1 (cdr p_0))) - (let ((start_2 start_1)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 pos_1 pos_2) - (begin - (if (if (< pos_1 end_1) #t #f) - (let ((result_1 - (let ((result_1 - (if (lazy-bytes-before-end? - s_0 - pos_2 - limit_0) - (let ((c1_0 + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (unsafe-fx+ idx_1 1)) + result_1))))) + result_0)))))) + (for-loop_0 #t start*_2 start*_1))))) + (args (raise-binding-result-arity-error 4 args))))) + (args (raise-binding-result-arity-error 4 args)))) + #f) + (let ((start_1 (car p_0))) + (let ((end_1 (cdr p_0))) + (let ((start_2 start_1)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 pos_1 pos_2) + (begin + (if (if (< pos_1 end_1) #t #f) + (let ((result_1 + (let ((result_1 + (if (lazy-bytes-before-end? + s_0 + pos_2 + limit_0) + (let ((c1_0 + (lazy-bytes-ref + s_0 + pos_1))) + (let ((c2_0 (lazy-bytes-ref s_0 - pos_1))) - (let ((c2_0 - (lazy-bytes-ref - s_0 - pos_2))) - (= c1_0 c2_0))) - #f))) - (values result_1)))) - (if (if (not - (let ((x_0 (list pos_1))) + pos_2))) + (= c1_0 c2_0))) + #f))) + (values result_1)))) + (if (if (not + (let ((x_0 (list pos_1))) + (not result_1))) + (if (not + (let ((x_0 (list pos_2))) (not result_1))) - (if (not - (let ((x_0 (list pos_2))) - (not result_1))) - #t - #f) + #t #f) - (let ((app_0 (+ pos_1 1))) - (for-loop_0 - result_1 - app_0 - (+ pos_2 1))) - result_1)) - result_0)))))) - (for-loop_0 #t start_2 pos_0))))))))) - (if matches?_0 - (|#%app| - next-m_0 - s_0 - (+ pos_0 len_0) - start_0 - limit_0 - end_0 - state_0 - stack_0) - #f))))))))) + #f) + (let ((app_0 (+ pos_1 1))) + (for-loop_0 + result_1 + app_0 + (+ pos_2 1))) + result_1)) + result_0)))))) + (for-loop_0 #t start_2 pos_0))))))))) + (if matches?_0 + (|#%app| + next-m_0 + s_0 + (+ pos_0 len_0) + start_0 + limit_0 + end_0 + state_0 + stack_0) + #f)))))))) (define reference-matcher/case-insensitive - (letrec ((procz4 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz3 (lambda (x_0) (bytes? x_0))) - (procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (n_0 next-m_0) - (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) - (let ((p_0 (vector-ref state_0 n_0))) - (if (not p_0) - #f - (let ((len_0 (let ((app_0 (cdr p_0))) (- app_0 (car p_0))))) - (let ((matches?_0 - (if (bytes? s_0) - (if (<= (+ pos_0 len_0) limit_0) - (call-with-values - (lambda () - (let ((app_0 (car p_0))) - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - s_0 - app_0 - (cdr p_0) - 1))) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz3 - procz4 - s_0 - pos_0 - (+ pos_0 len_0) - 1)) - (case-lambda - ((v*_1 start*_1 stop*_1 step*_1) - (let ((v*_2 v*_0) - (start*_2 start*_0) - (stop*_2 stop*_0) - (step*_2 step*_0)) - (begin - #t - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0 idx_1) - (begin - (if (if (unsafe-fx< idx_0 stop*_2) - (unsafe-fx< idx_1 stop*_1) - #f) - (let ((c1_0 + (lambda (n_0 next-m_0) + (lambda (s_0 pos_0 start_0 limit_0 end_0 state_0 stack_0) + (let ((p_0 (vector-ref state_0 n_0))) + (if (not p_0) + #f + (let ((len_0 (let ((app_0 (cdr p_0))) (- app_0 (car p_0))))) + (let ((matches?_0 + (if (bytes? s_0) + (if (<= (+ pos_0 len_0) limit_0) + (call-with-values + (lambda () + (let ((app_0 (car p_0))) + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + app_0 + (cdr p_0) + 1))) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + s_0 + pos_0 + (+ pos_0 len_0) + 1)) + (case-lambda + ((v*_1 start*_1 stop*_1 step*_1) + (let ((v*_2 v*_0) + (start*_2 start*_0) + (stop*_2 stop*_0) + (step*_2 step*_0)) + (begin + #t + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0 idx_1) + (begin + (if (if (unsafe-fx< idx_0 stop*_2) + (unsafe-fx< idx_1 stop*_1) + #f) + (let ((c1_0 + (unsafe-bytes-ref + v*_2 + idx_0))) + (let ((c2_0 (unsafe-bytes-ref - v*_2 - idx_0))) - (let ((c2_0 - (unsafe-bytes-ref - v*_1 - idx_1))) - (let ((c1_1 c1_0)) - (let ((result_1 - (let ((result_1 - (let ((app_0 - (chyte-to-lower - c1_1))) - (= - app_0 - (chyte-to-lower - c2_0))))) - (values - result_1)))) - (if (if (not + v*_1 + idx_1))) + (let ((c1_1 c1_0)) + (let ((result_1 + (let ((result_1 + (let ((app_0 + (chyte-to-lower + c1_1))) + (= + app_0 + (chyte-to-lower + c2_0))))) + (values result_1)))) + (if (if (not + (let ((x_0 + (list + c1_1))) + (not result_1))) + (if (not (let ((x_0 (list - c1_1))) + c2_0))) (not result_1))) - (if (not - (let ((x_0 - (list - c2_0))) - (not - result_1))) - #t - #f) + #t #f) - (for-loop_0 - result_1 - (unsafe-fx+ idx_0 1) - (unsafe-fx+ idx_1 1)) - result_1))))) - result_0)))))) - (for-loop_0 #t start*_2 start*_1))))) - (args - (raise-binding-result-arity-error 4 args))))) - (args (raise-binding-result-arity-error 4 args)))) - #f) - (let ((start_1 (car p_0))) - (let ((end_1 (cdr p_0))) - (let ((start_2 start_1)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 pos_1 pos_2) - (begin - (if (if (< pos_1 end_1) #t #f) - (let ((result_1 - (let ((result_1 - (if (lazy-bytes-before-end? - s_0 - pos_2 - limit_0) - (let ((c1_0 + #f) + (for-loop_0 + result_1 + (unsafe-fx+ idx_0 1) + (unsafe-fx+ idx_1 1)) + result_1))))) + result_0)))))) + (for-loop_0 #t start*_2 start*_1))))) + (args (raise-binding-result-arity-error 4 args))))) + (args (raise-binding-result-arity-error 4 args)))) + #f) + (let ((start_1 (car p_0))) + (let ((end_1 (cdr p_0))) + (let ((start_2 start_1)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 pos_1 pos_2) + (begin + (if (if (< pos_1 end_1) #t #f) + (let ((result_1 + (let ((result_1 + (if (lazy-bytes-before-end? + s_0 + pos_2 + limit_0) + (let ((c1_0 + (lazy-bytes-ref + s_0 + pos_1))) + (let ((c2_0 (lazy-bytes-ref s_0 - pos_1))) - (let ((c2_0 - (lazy-bytes-ref - s_0 - pos_2))) - (let ((app_0 - (chyte-to-lower - c1_0))) - (= - app_0 - (chyte-to-lower - c2_0))))) - #f))) - (values result_1)))) - (if (if (not - (let ((x_0 (list pos_1))) + pos_2))) + (let ((app_0 + (chyte-to-lower + c1_0))) + (= + app_0 + (chyte-to-lower + c2_0))))) + #f))) + (values result_1)))) + (if (if (not + (let ((x_0 (list pos_1))) + (not result_1))) + (if (not + (let ((x_0 (list pos_2))) (not result_1))) - (if (not - (let ((x_0 (list pos_2))) - (not result_1))) - #t - #f) + #t #f) - (let ((app_0 (+ pos_1 1))) - (for-loop_0 - result_1 - app_0 - (+ pos_2 1))) - result_1)) - result_0)))))) - (for-loop_0 #t start_2 pos_0))))))))) - (if matches?_0 - (|#%app| - next-m_0 - s_0 - (+ pos_0 len_0) - start_0 - limit_0 - end_0 - state_0 - stack_0) - #f))))))))) + #f) + (let ((app_0 (+ pos_1 1))) + (for-loop_0 + result_1 + app_0 + (+ pos_2 1))) + result_1)) + result_0)))))) + (for-loop_0 #t start_2 pos_0))))))))) + (if matches?_0 + (|#%app| + next-m_0 + s_0 + (+ pos_0 len_0) + start_0 + limit_0 + end_0 + state_0 + stack_0) + #f)))))))) (define chyte-to-lower (lambda (c_0) (if (if (>= c_0 65) (<= c_0 90) #f) (+ c_0 32) c_0))) (define lookahead-matcher @@ -8463,234 +8367,211 @@ (values #f #f))))))))))))) (loop_0 pos_0))))))))) (define check-must-string - (letrec ((procz6 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz5 (lambda (x_0) (bytes? x_0))) - (procz4 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz3 (lambda (x_0) (bytes? x_0))) - (procz2 (lambda (x_0) (unsafe-bytes-length x_0))) - (procz1 (lambda (x_0) (bytes? x_0)))) - (lambda (must-string_0 in_0 pos_0 end-pos_0) - (if (not must-string_0) + (lambda (must-string_0 in_0 pos_0 end-pos_0) + (if (not must-string_0) + #t + (if (not (bytes? in_0)) #t - (if (not (bytes? in_0)) - #t - (if (bytes? must-string_0) - (if (= 1 (unsafe-bytes-length must-string_0)) - (let ((mc_0 (unsafe-bytes-ref must-string_0 0))) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz1 - procz2 - in_0 - pos_0 - end-pos_0 - 1)) - (case-lambda - ((v*_0 start*_0 stop*_0 step*_0) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 idx_0) - (begin - (if (unsafe-fx< idx_0 stop*_0) - (let ((c_0 (unsafe-bytes-ref v*_0 idx_0))) - (let ((result_1 - (let ((result_1 (= c_0 mc_0))) - (values result_1)))) - (if (if (not - (let ((x_0 (list c_0))) result_1)) - #t - #f) - (for-loop_0 result_1 (unsafe-fx+ idx_0 1)) - result_1))) - result_0)))))) - (for-loop_0 #f start*_0)))) - (args (raise-binding-result-arity-error 4 args))))) - (let ((mc1_0 (unsafe-bytes-ref must-string_0 0))) - (let ((end_0 - (- - end-pos_0 - (sub1 (unsafe-bytes-length must-string_0))))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 pos_1) - (begin - (if (< pos_1 end_0) - (let ((result_1 - (let ((result_1 - (if (= - mc1_0 - (unsafe-bytes-ref in_0 pos_1)) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz3 - procz4 - in_0 - (add1 pos_1) - #f - 1)) - (case-lambda - ((v*_0 - start*_0 - stop*_0 - step*_0) - (call-with-values - (lambda () - (normalise-inputs - 'in-bytes - "byte string" - procz5 - procz6 - must-string_0 - 1 - #f - 1)) - (case-lambda - ((v*_1 - start*_1 - stop*_1 - step*_1) - (let ((v*_2 v*_0) - (start*_2 start*_0) - (stop*_2 stop*_0) - (step*_2 step*_0)) - (begin - #t - #t - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (result_1 - idx_0 - idx_1) - (begin - (if (if (unsafe-fx< - idx_0 - stop*_2) - (unsafe-fx< - idx_1 - stop*_1) - #f) - (let ((c_0 + (if (bytes? must-string_0) + (if (= 1 (unsafe-bytes-length must-string_0)) + (let ((mc_0 (unsafe-bytes-ref must-string_0 0))) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + in_0 + pos_0 + end-pos_0 + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 idx_0) + (begin + (if (unsafe-fx< idx_0 stop*_0) + (let ((c_0 (unsafe-bytes-ref v*_0 idx_0))) + (let ((result_1 + (let ((result_1 (= c_0 mc_0))) + (values result_1)))) + (if (if (not + (let ((x_0 (list c_0))) result_1)) + #t + #f) + (for-loop_0 result_1 (unsafe-fx+ idx_0 1)) + result_1))) + result_0)))))) + (for-loop_0 #f start*_0)))) + (args (raise-binding-result-arity-error 4 args))))) + (let ((mc1_0 (unsafe-bytes-ref must-string_0 0))) + (let ((end_0 + (- end-pos_0 (sub1 (unsafe-bytes-length must-string_0))))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 pos_1) + (begin + (if (< pos_1 end_0) + (let ((result_1 + (let ((result_1 + (if (= + mc1_0 + (unsafe-bytes-ref in_0 pos_1)) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + in_0 + (add1 pos_1) + #f + 1)) + (case-lambda + ((v*_0 start*_0 stop*_0 step*_0) + (call-with-values + (lambda () + (unsafe-normalise-inputs + unsafe-bytes-length + must-string_0 + 1 + #f + 1)) + (case-lambda + ((v*_1 + start*_1 + stop*_1 + step*_1) + (let ((v*_2 v*_0) + (start*_2 start*_0) + (stop*_2 stop*_0) + (step*_2 step*_0)) + (begin + #t + #t + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (result_1 + idx_0 + idx_1) + (begin + (if (if (unsafe-fx< + idx_0 + stop*_2) + (unsafe-fx< + idx_1 + stop*_1) + #f) + (let ((c_0 + (unsafe-bytes-ref + v*_2 + idx_0))) + (let ((mc_0 (unsafe-bytes-ref - v*_2 - idx_0))) - (let ((mc_0 - (unsafe-bytes-ref - v*_1 - idx_1))) - (let ((c_1 - c_0)) - (let ((result_2 - (let ((result_2 - (= - c_1 - mc_0))) - (values - result_2)))) - (if (if (not + v*_1 + idx_1))) + (let ((c_1 + c_0)) + (let ((result_2 + (let ((result_2 + (= + c_1 + mc_0))) + (values + result_2)))) + (if (if (not + (let ((x_0 + (list + c_1))) + (not + result_2))) + (if (not (let ((x_0 (list - c_1))) + mc_0))) (not result_2))) - (if (not - (let ((x_0 - (list - mc_0))) - (not - result_2))) - #t - #f) + #t #f) - (for-loop_1 - result_2 - (unsafe-fx+ - idx_0 - 1) - (unsafe-fx+ - idx_1 - 1)) - result_2))))) - result_1)))))) - (for-loop_1 - #t - start*_2 - start*_1))))) - (args - (raise-binding-result-arity-error - 4 - args))))) - (args - (raise-binding-result-arity-error - 4 - args)))) - #f))) - (values result_1)))) - (if (if (not - (let ((x_0 (list pos_1))) result_1)) - #t - #f) - (for-loop_0 result_1 (+ pos_1 1)) - result_1)) - result_0)))))) - (for-loop_0 #f pos_0)))))) - (let ((end_0 (- end-pos_0 (sub1 (length must-string_0))))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 pos_1) - (begin - (if (< pos_1 end_0) - (let ((result_1 - (let ((result_1 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (i_0 l_0) - (begin - (if (null? l_0) - #t - (let ((e_0 (car l_0))) - (if (let ((v_0 - (unsafe-bytes-ref - in_0 - i_0))) - (eq? - 1 - (unsafe-bytes-ref - e_0 - v_0))) - (let ((app_0 (add1 i_0))) - (loop_0 - app_0 - (cdr l_0))) - #f)))))))) - (loop_0 pos_1 must-string_0)))) - (values result_1)))) - (if (if (not (let ((x_0 (list pos_1))) result_1)) - #t - #f) - (for-loop_0 result_1 (+ pos_1 1)) - result_1)) - result_0)))))) - (for-loop_0 #f pos_0)))))))))) + #f) + (for-loop_1 + result_2 + (unsafe-fx+ + idx_0 + 1) + (unsafe-fx+ + idx_1 + 1)) + result_2))))) + result_1)))))) + (for-loop_1 + #t + start*_2 + start*_1))))) + (args + (raise-binding-result-arity-error + 4 + args))))) + (args + (raise-binding-result-arity-error + 4 + args)))) + #f))) + (values result_1)))) + (if (if (not (let ((x_0 (list pos_1))) result_1)) + #t + #f) + (for-loop_0 result_1 (+ pos_1 1)) + result_1)) + result_0)))))) + (for-loop_0 #f pos_0)))))) + (let ((end_0 (- end-pos_0 (sub1 (length must-string_0))))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 pos_1) + (begin + (if (< pos_1 end_0) + (let ((result_1 + (let ((result_1 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0 l_0) + (begin + (if (null? l_0) + #t + (let ((e_0 (car l_0))) + (if (let ((v_0 + (unsafe-bytes-ref + in_0 + i_0))) + (eq? + 1 + (unsafe-bytes-ref + e_0 + v_0))) + (let ((app_0 (add1 i_0))) + (loop_0 app_0 (cdr l_0))) + #f)))))))) + (loop_0 pos_1 must-string_0)))) + (values result_1)))) + (if (if (not (let ((x_0 (list pos_1))) result_1)) + #t + #f) + (for-loop_0 result_1 (+ pos_1 1)) + result_1)) + result_0)))))) + (for-loop_0 #f pos_0))))))))) (define check-start-range (lambda (start-range_0 in_0 pos_0 end-pos_0) (let ((v_0 diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index 82f79d4d00..bcbbf0f0ba 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -1942,6 +1942,13 @@ (begin (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0) (values vec_0 start_0 stop*_0 step_0))))))) +(define unsafe-normalise-inputs + (lambda (unsafe-vector-length_0 vec_0 start_0 stop_0 step_0) + (values + vec_0 + start_0 + (if stop_0 stop_0 (|#%app| unsafe-vector-length_0 vec_0)) + step_0))) (define check-vector (lambda (v_0) (if (vector? v_0) (void) (raise-argument-error 'in-vector "vector" v_0)))) @@ -48521,11 +48528,7 @@ (define fasl-hash-equal-variant 1) (define fasl-hash-eqv-variant 2) (define s-exp->fasl.1 - (letrec ((procz4 (lambda (x_0) (unsafe-vector-length x_0))) - (procz3 (lambda (x_0) (vector? x_0))) - (procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (loop_0 + (letrec ((loop_0 (|#%name| loop (lambda (external-lift?7_0 @@ -48655,11 +48658,8 @@ c1_0) (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector v_0) 1 #f @@ -49269,11 +49269,8 @@ o_0) (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz3 - procz4 + (unsafe-normalise-inputs + unsafe-vector-length vec_0 1 #f @@ -57422,9 +57419,7 @@ (for-loop_0 args-stack_0 0))))) (interpret-expr b_1 stack_0))))))))))))) (define interpret-expr - (letrec ((procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (apply-function_0 + (letrec ((apply-function_0 (|#%name| apply-function (lambda (b_0 captured_0 args_0) @@ -57736,11 +57731,8 @@ (lambda () (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length b64_0 2 #f diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm index 893947f256..9bdb72fd2c 100644 --- a/racket/src/cs/schemified/thread.scm +++ b/racket/src/cs/schemified/thread.scm @@ -655,6 +655,13 @@ (begin (check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0) (values vec_0 start_0 stop*_0 step_0))))))) +(define unsafe-normalise-inputs + (lambda (unsafe-vector-length_0 vec_0 start_0 stop_0 step_0) + (values + vec_0 + start_0 + (if stop_0 stop_0 (|#%app| unsafe-vector-length_0 vec_0)) + step_0))) (define check-vector (lambda (v_0) (if (vector? v_0) (void) (raise-argument-error 'in-vector "vector" v_0)))) @@ -3505,9 +3512,7 @@ (define 1/place-message-allowed? (|#%name| place-message-allowed? (lambda (v_0) (begin (allowed?.1 #f v_0))))) (define message-ize - (letrec ((procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (loop_0 + (letrec ((loop_0 (|#%name| loop (lambda (fail_0 graph_0 used_0 v_0) @@ -3681,11 +3686,8 @@ (reverse$1 (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector v_0) 1 #f @@ -3961,9 +3963,7 @@ (make-reader-graph (do-un-message-ize (message-ized-unmessage v_0))) v_0))) (define do-un-message-ize - (letrec ((procz2 (lambda (x_0) (unsafe-vector-length x_0))) - (procz1 (lambda (x_0) (vector? x_0))) - (loop_0 + (letrec ((loop_0 (|#%name| loop (lambda (graph_0 v_0) @@ -4063,11 +4063,8 @@ (reverse$1 (call-with-values (lambda () - (normalise-inputs - 'in-vector - "vector" - procz1 - procz2 + (unsafe-normalise-inputs + unsafe-vector-length (struct->vector v_0) 1 #f diff --git a/racket/src/io/demo.rkt b/racket/src/io/demo.rkt index a0e5e5393f..f4f569824d 100644 --- a/racket/src/io/demo.rkt +++ b/racket/src/io/demo.rkt @@ -828,7 +828,7 @@ (let loop ([j 10]) (unless (zero? j) (let () - (define p (open-input-file "compiled/io.rktl")) + (define p (open-input-file "../cs/schemified/io.scm")) (port-count-lines! p) (let loop () (define s (read-string 100 p)) @@ -845,7 +845,7 @@ (let loop ([j 10]) (unless (zero? j) (let () - (define p (host:open-input-file "compiled/io.rktl")) + (define p (host:open-input-file "../cs/schemified/io.scm")) (host:file-stream-buffer-mode p read-byte-buffer-mode) (when count-lines? (host:port-count-lines! p)) (let loop () @@ -859,7 +859,7 @@ (let loop ([j 10]) (unless (zero? j) (let () - (define p (open-input-file "compiled/io.rktl")) + (define p (open-input-file "../cs/schemified/io.scm")) (file-stream-buffer-mode p read-byte-buffer-mode) (when count-lines? (port-count-lines! p)) (let loop () @@ -873,7 +873,7 @@ (let loop ([j 10]) (unless (zero? j) (let () - (define p (host:open-input-file "compiled/io.rktl")) + (define p (host:open-input-file "../cs/schemified/io.scm")) (let loop () (unless (eof-object? (host:read-line p)) (loop))) @@ -885,7 +885,7 @@ (let loop ([j 10]) (unless (zero? j) (let () - (define p (open-input-file "compiled/io.rktl")) + (define p (open-input-file "../cs/schemified/io.scm")) (let loop () (unless (eof-object? (read-line p)) (loop))) diff --git a/racket/src/io/locale/recase.rkt b/racket/src/io/locale/recase.rkt index 03e0321b56..e96f5aaeb5 100644 --- a/racket/src/io/locale/recase.rkt +++ b/racket/src/io/locale/recase.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require "../common/check.rkt" +(require racket/fixnum + "../common/check.rkt" "../host/thread.rkt" "../host/rktio.rkt" "../host/error.rkt" @@ -30,16 +31,16 @@ ;; those directly (define len (string-length s)) (let loop ([pos 0]) - (define i-len (+ pos (string-length-up-to-nul s pos len))) + (define i-len (fx+ pos (string-length-up-to-nul s pos len))) (cond - [(= i-len len) + [(fx= i-len len) (define new-s (recase/no-nul (maybe-substring s pos len) up?)) (if (eqv? pos 0) new-s (list new-s))] [else (define new-s (recase/no-nul (substring s pos i-len) up?)) - (define r (loop (+ i-len 1))) + (define r (loop (fx+ i-len 1))) (if (eqv? pos 0) (apply string-append new-s (string #\nul) r) (cons new-s (cons (string #\nul) r)))]))) @@ -47,13 +48,13 @@ (define (recase/no-nul s up?) (cond [(and (equal? (current-locale) "") - (not (zero? (bitwise-and (rktio_convert_properties rktio) RKTIO_CONVERT_RECASE_UTF16)))) + (not (fx= 0 (fxand (rktio_convert_properties rktio) RKTIO_CONVERT_RECASE_UTF16)))) ;; The OS provides a UTF-16-based function, so use that (define s-16 (utf-16-encode s)) (start-atomic) (define r (rktio_recase_utf16 rktio up? - s-16 (arithmetic-shift (bytes-length s-16) -1) + s-16 (fxrshift (bytes-length s-16) 1) #f)) (define sr (rktio_to_shorts r)) (rktio_free r) @@ -72,7 +73,7 @@ (lambda () (let loop ([pos 0]) (cond - [(= pos (bytes-length in-bstr)) + [(fx= pos (bytes-length in-bstr)) (if (eqv? pos 0) "" '(""))] @@ -90,8 +91,8 @@ ls (list ls))] [else - (define r (loop (+ pos in-used 4))) - (define err-s (string (string-ref s (arithmetic-shift (+ pos in-used) -2)))) + (define r (loop (fx+ pos in-used 4))) + (define err-s (string (string-ref s (fxrshift (+ pos in-used) 2)))) (if (eqv? pos 0) (apply string-append ls err-s r) (list* ls err-s r))])]))) diff --git a/racket/src/io/string/utf-16-decode.rkt b/racket/src/io/string/utf-16-decode.rkt index da9af1dd70..3f05793c1b 100644 --- a/racket/src/io/string/utf-16-decode.rkt +++ b/racket/src/io/string/utf-16-decode.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require "../common/set-two.rkt") +(require racket/fixnum + "../common/set-two.rkt") (provide utf-16-decode) @@ -8,34 +9,34 @@ (define (utf-16-decode bstr) (define len (bytes-length bstr)) (define surrogate-count - (if (= len 0) + (if (fx= len 0) 0 (for/fold ([n 0]) ([b (in-bytes bstr (if big-endian? 0 1) len 2)]) - (if (= (bitwise-and b #xDC) #xD8) - (add1 n) + (if (fx= (fxand b #xDC) #xD8) + (fx+ n 1) n)))) - (define str (make-string (- (arithmetic-shift len -1) surrogate-count))) + (define str (make-string (fx- (fxrshift len 1) surrogate-count))) (let loop ([i 0] [pos 0]) - (unless (= i len) + (unless (fx= i len) (define a (bytes-ref bstr i)) - (define b (bytes-ref bstr (add1 i))) + (define b (bytes-ref bstr (fx+ i 1))) (define v (if big-endian? - (bitwise-ior (arithmetic-shift a 8) b) - (bitwise-ior (arithmetic-shift b 8) a))) + (fxior (fxlshift a 8) b) + (fxior (fxlshift b 8) a))) (cond - [(= (bitwise-and v #xDC00) #xDC00) + [(fx= (fxand v #xDC00) #xDC00) ;; surrogate pair - (define a (bytes-ref bstr (+ i 2))) - (define b (bytes-ref bstr (+ i 3))) + (define a (bytes-ref bstr (fx+ i 2))) + (define b (bytes-ref bstr (fx+ i 3))) (define v2 (if big-endian? - (bitwise-ior (arithmetic-shift a 8) b) - (bitwise-ior (arithmetic-shift b 8) a))) - (define all-v (+ #x10000 - (bitwise-ior (arithmetic-shift (bitwise-and v #x3FF) 10) - (bitwise-and v2 #x3FF)))) + (fxior (fxlshift a 8) b) + (fxior (fxlshift b 8) a))) + (define all-v (fx+ #x10000 + (fxior (fxlshift (fxand v #x3FF) 10) + (fxand v2 #x3FF)))) (string-set! str pos (integer->char all-v)) - (loop (+ i 4) (add1 pos))] + (loop (fx+ i 4) (fx+ pos 1))] [else (string-set! str pos (integer->char v)) - (loop (+ i 2) (add1 pos))]))) + (loop (fx+ i 2) (fx+ pos 1))]))) str) diff --git a/racket/src/io/string/utf-16-encode.rkt b/racket/src/io/string/utf-16-encode.rkt index 0c978b7324..2c311f6e9a 100644 --- a/racket/src/io/string/utf-16-encode.rkt +++ b/racket/src/io/string/utf-16-encode.rkt @@ -1,26 +1,27 @@ #lang racket/base -(require "../common/set-two.rkt") +(require racket/fixnum + "../common/set-two.rkt") (provide utf-16-encode) (define (utf-16-encode s) (define surrogate-count (for/fold ([n 0]) ([c (in-string s)]) - (if ((char->integer c) . >= . #x10000) - (add1 n) + (if ((char->integer c) . fx>= . #x10000) + (fx+ n 1) n))) - (define bstr (make-bytes (* 2 (+ (string-length s) surrogate-count)))) + (define bstr (make-bytes (fx* 2 (fx+ (string-length s) surrogate-count)))) (for/fold ([pos 0]) ([c (in-string s)]) (define v (char->integer c)) (cond - [(v . >= . #x10000) - (define av (- v #x10000)) - (define hi (bitwise-ior #xD800 (bitwise-and (arithmetic-shift av -10) #x3FF))) - (define lo (bitwise-ior #xDC00 (bitwise-and av #x3FF))) - (bytes-set-two! bstr pos (arithmetic-shift hi -8) (bitwise-and hi #xFF)) - (bytes-set-two! bstr pos (arithmetic-shift lo -8) (bitwise-and lo #xFF)) - (+ pos 4)] + [(v . fx>= . #x10000) + (define av (fx- v #x10000)) + (define hi (fxior #xD800 (fxand (fxrshift av 10) #x3FF))) + (define lo (fxior #xDC00 (fxand av #x3FF))) + (bytes-set-two! bstr pos (fxrshift hi 8) (fxand hi #xFF)) + (bytes-set-two! bstr pos (fxrshift lo 8) (fxand lo #xFF)) + (fx+ pos 4)] [else - (bytes-set-two! bstr pos (arithmetic-shift v -8) (bitwise-and v #xFF)) - (+ pos 2)])) + (bytes-set-two! bstr pos (fxrshift v 8) (fxand v #xFF)) + (fx+ pos 2)])) bstr) diff --git a/racket/src/io/string/utf-8-encode.rkt b/racket/src/io/string/utf-8-encode.rkt index 414ae2f1d6..9c114ca8c9 100644 --- a/racket/src/io/string/utf-8-encode.rkt +++ b/racket/src/io/string/utf-8-encode.rkt @@ -27,21 +27,21 @@ out-bstr out-start out-end j continue) (cond - [(b . <= . #x7F) + [(b . fx<= . #x7F) (cond - [(and out-end (= j out-end)) + [(and out-end (fx= j out-end)) (values (fx- i in-start) (fx- j out-start) 'continues)] [else (when out-bstr (bytes-set! out-bstr j b)) (continue (fx+ j 1))])] - [(b . <= . #x7FF) + [(b . fx<= . #x7FF) (cond [(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)))) + (bytes-set! out-bstr j (fxior #b11000000 (fxrshift b 6))) + (bytes-set! out-bstr (fx+ j 1) (fxior #b10000000 (fxand b #b111111)))) (continue (+ j 2))])] [(b . fx<= . #xFFFF) (cond @@ -49,10 +49,10 @@ (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 (fx+ j 1) (bitwise-ior #b10000000 (bitwise-and (arithmetic-shift b -6) - #b111111))) - (bytes-set! out-bstr (fx+ j 2) (bitwise-ior #b10000000 (bitwise-and b #b111111)))) + (bytes-set! out-bstr j (fxior #b11100000 (fxrshift b 12))) + (bytes-set! out-bstr (fx+ j 1) (fxior #b10000000 (fxand (fxrshift b 6) + #b111111))) + (bytes-set! out-bstr (fx+ j 2) (fxior #b10000000 (fxand b #b111111)))) (continue (fx+ j 3))])] [else (cond @@ -60,10 +60,10 @@ (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 (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)))) + (bytes-set! out-bstr j (fxior #b11110000 (fxrshift b 18))) + (bytes-set! out-bstr (fx+ j 1) (fxior #b10000000 (fxand (fxrshift b 12) + #b111111))) + (bytes-set! out-bstr (fx+ j 2) (fxior #b10000000 (fxand (fxrshift b 6) + #b111111))) + (bytes-set! out-bstr (fx+ j 3) (fxior #b10000000 (fxand b #b111111)))) (continue (fx+ j 4))])]))