diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index faf0f68646..a9683d5039 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "7.9.0.18") +(define version "7.9.0.19") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-test-core/tests/racket/basic.rktl b/pkgs/racket-test-core/tests/racket/basic.rktl index b02ca1029f..a10d85df01 100644 --- a/pkgs/racket-test-core/tests/racket/basic.rktl +++ b/pkgs/racket-test-core/tests/racket/basic.rktl @@ -2129,6 +2129,25 @@ (escape1 3)))))))) (sync ch)) +;; Make sure allocation and continuation capture are left-to-right in +;; a function call: +(let ([join (if (zero? (random 1)) list 'oops)]) + (let ([k0 (cadr + (call-with-continuation-prompt + (lambda () + (join (cons 1 2) + (call/cc (lambda (k) k))))))] + [k1 (car + (call-with-continuation-prompt + (lambda () + (join (call/cc (lambda (k) k)) + (cons 1 2)))))]) + (define (do-k k) (call-with-continuation-prompt + (lambda () + (k k)))) + (test #t eq? (car (do-k k0)) (car (do-k k0))) + (test #f eq? (cadr (do-k k1)) (cadr (do-k k1))))) + (arity-test call/cc 1 2) (arity-test call/ec 1 1) (err/rt-test (call/cc 4)) diff --git a/pkgs/racket-test-core/tests/racket/optimize.rktl b/pkgs/racket-test-core/tests/racket/optimize.rktl index f402f9a463..587bd02693 100644 --- a/pkgs/racket-test-core/tests/racket/optimize.rktl +++ b/pkgs/racket-test-core/tests/racket/optimize.rktl @@ -1231,7 +1231,8 @@ ;; Ok to move `box' past a side effect (that can't capture a ;; resumable continuation): -(test-comp '(let ([h (box 0.0)]) +(test-comp #:except 'chez-scheme + '(let ([h (box 0.0)]) (list (random) h)) '(list (random) (box 0.0))) @@ -1259,7 +1260,8 @@ ;; Do copy-propagate a reference to a mutable top-level ;; across non-effects: -(test-comp '(module m racket/base +(test-comp #:except 'chez-scheme + '(module m racket/base (define x 10) (define (f y) (let ([old x]) @@ -1319,7 +1321,8 @@ '(let* ([x (cons 1 1)]) (cons x x))) (test-comp '(let* ([x 1][y (add1 x)]) (+ y x)) '3) -(test-comp '(letrec ([x (cons 1 1)][y x]) (cons x y)) +(test-comp #:except 'chez-scheme + '(letrec ([x (cons 1 1)][y x]) (cons x y)) '(letrec ([x (cons 1 1)][y x]) (cons x x))) ;; Remove unnecessary bindings @@ -1426,7 +1429,8 @@ '(values 1 2) #f) ; car is a primitive, map is required from another module -(test-comp '(lambda (x) (if (null? x) car car)) +(test-comp #:except 'chez-scheme + '(lambda (x) (if (null? x) car car)) '(lambda (x) car)) (test-comp '(lambda (x) (if (null? x) map map)) '(lambda (x) map)) @@ -1436,11 +1440,14 @@ '(module ? racket/base (define x (if (zero? (random 2)) '() '(1))) x)) -(test-comp '(lambda (x) (if (null? x) x x)) +(test-comp #:except 'chez-scheme + '(lambda (x) (if (null? x) x x)) '(lambda (x) x)) -(test-comp '(lambda (x) (if (null? x) null x)) +(test-comp #:except 'chez-scheme + '(lambda (x) (if (null? x) null x)) '(lambda (x) x)) -(test-comp '(lambda (x) (not (if (null? x) #t x))) +(test-comp #:except 'chez-scheme + '(lambda (x) (not (if (null? x) #t x))) '(lambda (x) (not x))) ;reduce ignored `if`s @@ -1452,11 +1459,14 @@ '(lambda () (void (random 2)))) (test-comp '(lambda (x) (void (if (eq? (random 2) 0) (box x) (list x)))) '(lambda (x) (void (random 2)))) -(test-comp '(lambda (x) (void (if x (random) 1))) +(test-comp #:except 'chez-scheme + '(lambda (x) (void (if x (random) 1))) '(lambda (x) (void (if x (random) 2)))) -(test-comp '(lambda (x) (void (if x 1 (random)))) +(test-comp #:except 'chez-scheme + '(lambda (x) (void (if x 1 (random)))) '(lambda (x) (void (if x 2 (random))))) -(test-comp '(lambda (x) (void (if x (random) 1))) +(test-comp #:except 'chez-scheme + '(lambda (x) (void (if x (random) 1))) '(lambda (x) (void)) #f) (test-comp '(lambda (x) (void (if x 1 (random)))) @@ -1523,7 +1533,8 @@ (test-comp '(lambda (x) (if (pair? x) #t #f)) '(lambda (x) (pair? x))) -(test-comp '(lambda (x) (let ([r (something)]) +(test-comp #:except 'chez-scheme + '(lambda (x) (let ([r (something)]) (if r #t (something-else)))) '(lambda (x) (if (something) #t (something-else)))) diff --git a/racket/src/cs/primitive/kernel.ss b/racket/src/cs/primitive/kernel.ss index f82b315f1c..4ece70e872 100644 --- a/racket/src/cs/primitive/kernel.ss +++ b/racket/src/cs/primitive/kernel.ss @@ -41,9 +41,9 @@ [bitwise-not (known-procedure/folding 2)] [bitwise-xor (known-procedure/folding -1)] [boolean? (known-procedure/pure/folding 2)] - [box (known-procedure/pure 2)] + [box (known-procedure/allocates 2)] [box-cas! (known-procedure/has-unsafe 8 'unsafe-box*-cas!)] - [box-immutable (known-procedure/pure 2)] + [box-immutable (known-procedure/allocates 2)] [box? (known-procedure/pure/folding 2)] [break-enabled (known-procedure/no-prompt 3)] [break-thread (known-procedure/no-prompt 6)] @@ -185,7 +185,7 @@ [compile-target-machine? (known-procedure/no-prompt 2)] [complete-path? (known-procedure/no-prompt 2)] [complex? (known-procedure/pure/folding 2)] - [cons (known-procedure/pure 4)] + [cons (known-procedure/allocates 4)] [continuation-mark-key? (known-procedure/pure/folding 2)] [continuation-mark-set->context (known-procedure/no-prompt 2)] [continuation-mark-set->iterator (known-procedure/no-prompt 28)] @@ -471,8 +471,8 @@ [lcm (known-procedure/folding -1)] [length (known-procedure/no-prompt 2)] [link-exists? (known-procedure/no-prompt 2)] - [list (known-procedure/pure -1)] - [list* (known-procedure/pure -2)] + [list (known-procedure/allocates -1)] + [list* (known-procedure/allocates -2)] [list->bytes (known-procedure/no-prompt 2)] [list->string (known-procedure/no-prompt 2)] [list->vector (known-procedure/no-prompt 2)] @@ -493,7 +493,7 @@ [logger? (known-procedure/pure/folding 2)] [magnitude (known-procedure/folding 2)] [make-bytes (known-procedure/no-prompt 6)] - [make-channel (known-procedure/pure 1)] + [make-channel (known-procedure/allocates 1)] [make-continuation-mark-key (known-procedure/no-prompt 3)] [make-continuation-prompt-tag (known-procedure/no-prompt 3)] [make-custodian (known-procedure/no-prompt 3)] @@ -501,7 +501,7 @@ [make-derived-parameter (known-procedure/single-valued 8)] [make-directory (known-procedure/no-prompt 2)] [make-environment-variables (known-procedure/no-prompt -1)] - [make-ephemeron (known-procedure/pure 4)] + [make-ephemeron (known-procedure/allocates 4)] [make-file-or-directory-link (known-procedure/no-prompt 4)] [make-hash (known-procedure/single-valued 3)] [make-hash-placeholder (known-procedure/no-prompt 2)] @@ -522,8 +522,8 @@ [make-parameter (known-procedure/single-valued 14)] [make-phantom-bytes (known-procedure/no-prompt 2)] [make-pipe (known-procedure/no-prompt/multi 15)] - [make-placeholder (known-procedure/pure 2)] - [make-plumber (known-procedure/pure 1)] + [make-placeholder (known-procedure/allocates 2)] + [make-plumber (known-procedure/allocates 1)] [make-polar (known-procedure/folding 4)] [make-prefab-struct (known-procedure/single-valued -2)] [make-pseudo-random-generator (known-procedure/no-prompt 1)] ; not pure, depends on (current-milliseconds) @@ -538,19 +538,19 @@ [make-struct-field-mutator (known-procedure/single-valued 12)] [make-struct-type (known-procedure 4080)] [make-struct-type-property (known-procedure 30)] - [make-thread-cell (known-procedure/pure 6)] + [make-thread-cell (known-procedure/allocates 6)] [make-thread-group (known-procedure/no-prompt 3)] [make-vector (known-procedure/no-prompt 6)] - [make-weak-box (known-procedure/pure 2)] + [make-weak-box (known-procedure/allocates 2)] [make-weak-hash (known-procedure/single-valued 3)] [make-weak-hasheq (known-procedure/no-prompt 3)] [make-weak-hasheqv (known-procedure/no-prompt 3)] - [make-will-executor (known-procedure/pure 1)] + [make-will-executor (known-procedure/allocates 1)] [map (known-procedure/single-valued -4)] [max (known-procedure/folding -2)] [mcar (known-procedure/has-unsafe 2 'unsafe-mcar)] [mcdr (known-procedure/has-unsafe 2 'unsafe-mcdr)] - [mcons (known-procedure/pure 4)] + [mcons (known-procedure/allocates 4)] [memory-order-acquire (known-procedure/single-valued 1)] [memory-order-release (known-procedure/single-valued 1)] [min (known-procedure/folding -2)] @@ -944,7 +944,7 @@ [unquoted-printing-string-value (known-procedure/single-valued 2)] [unquoted-printing-string? (known-procedure/no-prompt 2)] [values (known-procedure/no-prompt/multi -1)] ; not marked as pure, because it is not single valued - [vector (known-procedure/pure -1)] + [vector (known-procedure/allocates -1)] [vector->immutable-vector (known-procedure/single-valued 2)] [vector->list (known-procedure/single-valued 2)] [vector->pseudo-random-generator (known-procedure/single-valued 2)] @@ -953,7 +953,7 @@ [vector-cas! (known-procedure/has-unsafe 16 'unsafe-vector*-cas!)] [vector-copy! (known-procedure/single-valued 56)] [vector-fill! (known-procedure/single-valued 4)] - [vector-immutable (known-procedure/pure -1)] + [vector-immutable (known-procedure/allocates -1)] [vector-length (known-procedure/no-prompt 2)] [vector-ref (known-procedure/single-valued 4)] [vector-set! (known-procedure/single-valued 8)] diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index e643560c94..6549ae1ccd 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -1276,18 +1276,20 @@ keyword-procedure? keyword-procedure-ref keyword-procedure-set!) - (make-struct-type - 'keyword-procedure - #f - 4 - 0 - #f - (list - (cons prop:checked-procedure #t) - (cons prop:impersonator-of keyword-procedure-impersonator-of)) - (current-inspector) - #f - '(0 1 2 3))) + (let ((app_0 + (list + (cons prop:checked-procedure #t) + (cons prop:impersonator-of keyword-procedure-impersonator-of)))) + (make-struct-type + 'keyword-procedure + #f + 4 + 0 + #f + app_0 + (current-inspector) + #f + '(0 1 2 3)))) (define keyword-procedure-required (make-struct-field-accessor keyword-procedure-ref 2)) (define keyword-procedure-allowed @@ -5476,8 +5478,7 @@ (if or-part_0 or-part_0 (let ((pruned-t_0 - (if (let ((app_0 (table-count t_0))) - (= app_0 (table-prune-at t_0))) + (if (= (table-count t_0) (table-prune-at t_0)) (prune-table t_0) t_0))) (let ((ht_0 (table-ht pruned-t_0))) @@ -5486,9 +5487,10 @@ (hash-set ht_0 code_0 - (cons - (make-weak-box v_0) - (hash-ref ht_0 code_0 null))))) + (let ((app_0 (make-weak-box v_0))) + (cons + app_0 + (hash-ref ht_0 code_0 null)))))) (let ((app_1 (add1 (table-count pruned-t_0)))) (table2.1 app_0 @@ -5501,8 +5503,8 @@ (weak-intern! tt_0 v_0)))))))))))))) (define prune-table (lambda (t_0) - (let ((new-ht_0 - (let ((ht_0 (table-ht t_0))) + (let ((ht_0 (table-ht t_0))) + (let ((new-ht_0 (begin (letrec* ((for-loop_0 @@ -5582,34 +5584,34 @@ (hash-iterate-next ht_0 i_0)))) (args (raise-binding-result-arity-error 2 args)))) table_0)))))) - (for-loop_0 hash2725 (hash-iterate-first ht_0))))))) - (let ((count_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (result_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () (hash-iterate-key+value new-ht_0 i_0)) - (case-lambda - ((k_0 vals_0) - (let ((result_1 - (let ((result_1 - (+ result_0 (length vals_0)))) - (values result_1)))) - (for-loop_0 - result_1 - (hash-iterate-next new-ht_0 i_0)))) - (args (raise-binding-result-arity-error 2 args)))) - result_0)))))) - (for-loop_0 0 (hash-iterate-first new-ht_0)))))) - (table2.1 new-ht_0 count_0 (max 128 (* 2 count_0))))))) + (for-loop_0 hash2725 (hash-iterate-first ht_0)))))) + (let ((count_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (result_0 i_0) + (begin + (if i_0 + (call-with-values + (lambda () (hash-iterate-key+value new-ht_0 i_0)) + (case-lambda + ((k_0 vals_0) + (let ((result_1 + (let ((result_1 + (+ result_0 (length vals_0)))) + (values result_1)))) + (for-loop_0 + result_1 + (hash-iterate-next new-ht_0 i_0)))) + (args (raise-binding-result-arity-error 2 args)))) + result_0)))))) + (for-loop_0 0 (hash-iterate-first new-ht_0)))))) + (table2.1 new-ht_0 count_0 (max 128 (* 2 count_0)))))))) (define struct:resolved-module-path (make-record-type-descriptor* 'resolved-module-path #f #f #f #f 1 0)) -(define effect_2722 +(define effect_1951 (struct-type-install-properties! struct:resolved-module-path 'resolved-module-path @@ -5638,8 +5640,10 @@ prop:equal+hash (list (lambda (a_0 b_0 eql?_0) - (let ((app_0 (1/resolved-module-path-name a_0))) - (|#%app| eql?_0 app_0 (1/resolved-module-path-name b_0)))) + (|#%app| + eql?_0 + (1/resolved-module-path-name a_0) + (1/resolved-module-path-name b_0))) (lambda (a_0 hash-code_0) (|#%app| hash-code_0 (1/resolved-module-path-name a_0))) (lambda (a_0 hash-code_0) @@ -5781,7 +5785,7 @@ root-mod-path_0)))))) (define struct:module-path-index (make-record-type-descriptor* 'module-path-index #f #f #f #f 4 12)) -(define effect_2455 +(define effect_2287 (struct-type-install-properties! struct:module-path-index 'module-path-index @@ -5886,10 +5890,14 @@ prop:equal+hash (list (lambda (a_0 b_0 eql?_0) - (if (let ((app_0 (module-path-index-path a_0))) - (|#%app| eql?_0 app_0 (module-path-index-path b_0))) - (let ((app_0 (module-path-index-base a_0))) - (|#%app| eql?_0 app_0 (module-path-index-base b_0))) + (if (|#%app| + eql?_0 + (module-path-index-path a_0) + (module-path-index-path b_0)) + (|#%app| + eql?_0 + (module-path-index-base a_0) + (module-path-index-base b_0)) #f)) (lambda (a_0 hash-code_0) (let ((app_0 (|#%app| hash-code_0 (module-path-index-path a_0)))) @@ -6110,8 +6118,9 @@ 'module-path-index-split "module-path-index?" mpi_0)) - (let ((app_0 (module-path-index-path mpi_0))) - (values app_0 (module-path-index-base mpi_0)))))))) + (values + (module-path-index-path mpi_0) + (module-path-index-base mpi_0))))))) (define 1/module-path-index-submodule (|#%name| module-path-index-submodule @@ -6222,11 +6231,9 @@ (let ((result_1 (let ((v_0 (weak-box-value wb_0))) (if v_0 - (if (let ((app_0 - (module-path-index-path v_0))) - (equal? - app_0 - (module-path-index-path mpi_0))) + (if (equal? + (module-path-index-path v_0) + (module-path-index-path mpi_0)) v_0 #f) #f)))) @@ -6238,29 +6245,30 @@ (for-loop_0 #f cache_0))))) (define shift-cache-set! (lambda (base_0 v_0) - (let ((new-cache_0 - (cons - (make-weak-box v_0) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (n_0 l_0) - (begin - (if (null? l_0) - null - (if (eqv? n_0 0) + (let ((app_0 (make-weak-box v_0))) + (let ((new-cache_0 + (cons + app_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (n_0 l_0) + (begin + (if (null? l_0) null - (if (not (weak-box-value (car l_0))) - (loop_0 n_0 (cdr l_0)) - (let ((r_0 - (let ((app_0 (fx- n_0 1))) - (loop_0 app_0 (cdr l_0))))) - (if (eq? r_0 (cdr l_0)) - l_0 - (cons (car l_0) r_0))))))))))) - (loop_0 32 (module-path-index-shift-cache base_0)))))) - (set-module-path-index-shift-cache! base_0 new-cache_0)))) + (if (eqv? n_0 0) + null + (if (not (weak-box-value (car l_0))) + (loop_0 n_0 (cdr l_0)) + (let ((r_0 + (let ((app_1 (fx- n_0 1))) + (loop_0 app_1 (cdr l_0))))) + (if (eq? r_0 (cdr l_0)) + l_0 + (cons (car l_0) r_0))))))))))) + (loop_0 32 (module-path-index-shift-cache base_0)))))) + (set-module-path-index-shift-cache! base_0 new-cache_0))))) (define top-level-module-path-index (make-self-module-path-index (1/make-resolved-module-path 'top-level))) (define top-level-module-path-index? @@ -6275,8 +6283,9 @@ (if (1/module-path-index? mpi_0) (if (1/module-path-index? inside-mpi_0) (if (module-path-index-resolved mpi_0) - (let ((app_0 (module-path-index-resolved mpi_0))) - (eq? app_0 (module-path-index-resolved inside-mpi_0))) + (eq? + (module-path-index-resolved mpi_0) + (module-path-index-resolved inside-mpi_0)) #f) #f) #f))))) @@ -6601,19 +6610,20 @@ (let ((app_6 (make-hasheq))) (let ((app_7 (make-hasheq))) (let ((app_8 (make-hash))) - (serialize-state1.1 - reachable-scopes_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - (box null) - (make-hasheq))))))))))))) + (let ((app_9 (box null))) + (serialize-state1.1 + reachable-scopes_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + app_7 + app_8 + app_9 + (make-hasheq)))))))))))))) (let ((empty-seteq_0 (seteq))) (begin (hash-set! @@ -7373,7 +7383,7 @@ modified-content-scope-propagations+tamper (record-accessor struct:modified-content 1))) (define struct:syntax (make-record-type-descriptor* 'syntax #f #f #f #f 7 1)) -(define effect_2384 +(define effect_2343 (struct-type-install-properties! struct:syntax 'syntax @@ -7584,10 +7594,9 @@ (if (if (eq? context-triple_0 (syntax-state-context-triple stx-state_0)) - (let ((app_0 (syntax-srcloc s_0))) - (equal? - app_0 - (syntax-state-srcloc stx-state_0))) + (equal? + (syntax-srcloc s_0) + (syntax-state-srcloc stx-state_0)) #f) (void) (set-syntax-state-all-sharing?! stx-state_0 #f)) @@ -7925,22 +7934,14 @@ #f) (if (syntax?$1 result-s_0) (let ((props20_0 (syntax-props stx-p4_0))) - (let ((app_0 (syntax-content* result-s_0))) - (let ((app_1 (syntax-scopes result-s_0))) - (let ((app_2 - (syntax-shifted-multi-scopes - result-s_0))) - (let ((app_3 - (syntax-mpi-shifts result-s_0))) - (let ((app_4 (syntax-srcloc result-s_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - props20_0 - (syntax-inspector result-s_0)))))))) + (syntax2.1 + (syntax-content* result-s_0) + (syntax-scopes result-s_0) + (syntax-shifted-multi-scopes result-s_0) + (syntax-mpi-shifts result-s_0) + (syntax-srcloc result-s_0) + props20_0 + (syntax-inspector result-s_0))) (raise-argument-error 'struct-copy "syntax?" @@ -8671,10 +8672,9 @@ (let ((new-syms/serialize_0 (if just-for-nominal?_0 (table-with-bulk-bindings-syms/serialize bt_0) - (if (let ((app_0 (table-with-bulk-bindings-syms bt_0))) - (eq? - app_0 - (table-with-bulk-bindings-syms/serialize bt_0))) + (if (eq? + (table-with-bulk-bindings-syms bt_0) + (table-with-bulk-bindings-syms/serialize bt_0)) new-syms_0 (binding-table-add (table-with-bulk-bindings-syms/serialize bt_0) @@ -8700,32 +8700,31 @@ (lambda (shadow-except4_0 bt6_0 scopes7_0 bulk8_0) (begin (if (table-with-bulk-bindings? bt6_0) - (let ((new-syms_0 - (let ((temp28_0 (table-with-bulk-bindings-syms bt6_0))) + (let ((temp28_0 (table-with-bulk-bindings-syms bt6_0))) + (let ((new-syms_0 (remove-matching-bindings.1 shadow-except4_0 temp28_0 scopes7_0 - bulk8_0)))) - (let ((new-syms/serialize_0 - (if (let ((app_0 (table-with-bulk-bindings-syms bt6_0))) - (eq? - app_0 - (table-with-bulk-bindings-syms/serialize bt6_0))) - new-syms_0 - (let ((temp32_0 - (table-with-bulk-bindings-syms/serialize bt6_0))) - (remove-matching-bindings.1 - shadow-except4_0 - temp32_0 - scopes7_0 - bulk8_0))))) - (table-with-bulk-bindings1.1 - new-syms_0 - new-syms/serialize_0 - (cons - (bulk-binding-at2.1 scopes7_0 bulk8_0) - (table-with-bulk-bindings-bulk-bindings bt6_0))))) + bulk8_0))) + (let ((new-syms/serialize_0 + (if (eq? + (table-with-bulk-bindings-syms bt6_0) + (table-with-bulk-bindings-syms/serialize bt6_0)) + new-syms_0 + (let ((temp32_0 + (table-with-bulk-bindings-syms/serialize bt6_0))) + (remove-matching-bindings.1 + shadow-except4_0 + temp32_0 + scopes7_0 + bulk8_0))))) + (table-with-bulk-bindings1.1 + new-syms_0 + new-syms/serialize_0 + (cons + (bulk-binding-at2.1 scopes7_0 bulk8_0) + (table-with-bulk-bindings-bulk-bindings bt6_0)))))) (let ((temp36_0 (table-with-bulk-bindings1.1 bt6_0 bt6_0 null))) (binding-table-add-bulk.1 #f temp36_0 scopes7_0 bulk8_0))))))) (define remove-matching-bindings.1 @@ -8841,8 +8840,9 @@ (lambda () (if (hash? table_0) (values table_0 null) - (let ((app_0 (table-with-bulk-bindings-syms table_0))) - (values app_0 (table-with-bulk-bindings-bulk-bindings table_0))))) + (values + (table-with-bulk-bindings-syms table_0) + (table-with-bulk-bindings-bulk-bindings table_0)))) (case-lambda ((ht_0 bulk-bindings_0) (let ((app_0 @@ -9406,19 +9406,14 @@ val_0))) (if (syntax?$1 s_0) (let ((props2_0 (hash-set (syntax-props s_0) key_0 pval_0))) - (let ((app_0 (syntax-content* s_0))) - (let ((app_1 (syntax-scopes s_0))) - (let ((app_2 (syntax-shifted-multi-scopes s_0))) - (let ((app_3 (syntax-mpi-shifts s_0))) - (let ((app_4 (syntax-srcloc s_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - props2_0 - (syntax-inspector s_0)))))))) + (syntax2.1 + (syntax-content* s_0) + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + props2_0 + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" s_0))))) ((s_0 key_0 val_0 preserved?_0) (begin @@ -9441,19 +9436,14 @@ (if preserved?_0 (preserved-property-value1.1 val_0) val_0))) (if (syntax?$1 s_0) (let ((props3_0 (hash-set (syntax-props s_0) key_0 pval_0))) - (let ((app_0 (syntax-content* s_0))) - (let ((app_1 (syntax-scopes s_0))) - (let ((app_2 (syntax-shifted-multi-scopes s_0))) - (let ((app_3 (syntax-mpi-shifts s_0))) - (let ((app_4 (syntax-srcloc s_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - props3_0 - (syntax-inspector s_0)))))))) + (syntax2.1 + (syntax-content* s_0) + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + props3_0 + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" s_0))))))))) (define 1/syntax-property-preserved? (|#%name| @@ -9523,19 +9513,14 @@ (if (hash-ref (syntax-props s_0) key_0 #f) (if (syntax?$1 s_0) (let ((props7_0 (hash-remove (syntax-props s_0) key_0))) - (let ((app_0 (syntax-content* s_0))) - (let ((app_1 (syntax-scopes s_0))) - (let ((app_2 (syntax-shifted-multi-scopes s_0))) - (let ((app_3 (syntax-mpi-shifts s_0))) - (let ((app_4 (syntax-srcloc s_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - props7_0 - (syntax-inspector s_0)))))))) + (syntax2.1 + (syntax-content* s_0) + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + props7_0 + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" s_0)) s_0)))))) (define syntax-has-property? @@ -9578,21 +9563,14 @@ content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes sub-s_0))) - (let ((app_1 - (syntax-shifted-multi-scopes - sub-s_0))) - (let ((app_2 (syntax-mpi-shifts sub-s_0))) - (let ((app_3 (syntax-srcloc sub-s_0))) - (let ((app_4 (syntax-props sub-s_0))) - (syntax2.1 - content*3_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector sub-s_0)))))))) + (syntax2.1 + content*3_0 + (syntax-scopes sub-s_0) + (syntax-shifted-multi-scopes sub-s_0) + (syntax-mpi-shifts sub-s_0) + (syntax-srcloc sub-s_0) + (syntax-props sub-s_0) + (syntax-inspector sub-s_0))) (raise-argument-error 'struct-copy "syntax?" @@ -9725,19 +9703,14 @@ (if new-p_0 (modified-content1.1 content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-shifted-multi-scopes s_0))) - (let ((app_2 (syntax-mpi-shifts s_0))) - (let ((app_3 (syntax-srcloc s_0))) - (let ((app_4 (syntax-props s_0))) - (syntax2.1 - content*4_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s_0)))))))) + (syntax2.1 + content*4_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + (syntax-props s_0) + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" @@ -9807,20 +9780,14 @@ (if new-p_0 (modified-content1.1 content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s2_0))) - (let ((app_1 - (syntax-shifted-multi-scopes s2_0))) - (let ((app_2 (syntax-mpi-shifts s2_0))) - (let ((app_3 (syntax-srcloc s2_0))) - (let ((app_4 (syntax-props s2_0))) - (syntax2.1 - content*5_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s2_0)))))))) + (syntax2.1 + content*5_0 + (syntax-scopes s2_0) + (syntax-shifted-multi-scopes s2_0) + (syntax-mpi-shifts s2_0) + (syntax-srcloc s2_0) + (syntax-props s2_0) + (syntax-inspector s2_0))) (raise-argument-error 'struct-copy "syntax?" @@ -9856,20 +9823,14 @@ content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s2_0))) - (let ((app_1 - (syntax-shifted-multi-scopes s2_0))) - (let ((app_2 (syntax-mpi-shifts s2_0))) - (let ((app_3 (syntax-srcloc s2_0))) - (let ((app_4 (syntax-props s2_0))) - (syntax2.1 - content*6_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s2_0)))))))) + (syntax2.1 + content*6_0 + (syntax-scopes s2_0) + (syntax-shifted-multi-scopes s2_0) + (syntax-mpi-shifts s2_0) + (syntax-srcloc s2_0) + (syntax-props s2_0) + (syntax-inspector s2_0))) (raise-argument-error 'struct-copy "syntax?" @@ -9914,19 +9875,14 @@ (if new-p_0 (modified-content1.1 content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-shifted-multi-scopes s_0))) - (let ((app_2 (syntax-mpi-shifts s_0))) - (let ((app_3 (syntax-srcloc s_0))) - (let ((app_4 (syntax-props s_0))) - (syntax2.1 - content*7_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s_0)))))))) + (syntax2.1 + content*7_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + (syntax-props s_0) + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" @@ -9954,19 +9910,14 @@ (if new-p_0 (modified-content1.1 content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-shifted-multi-scopes s_0))) - (let ((app_2 (syntax-mpi-shifts s_0))) - (let ((app_3 (syntax-srcloc s_0))) - (let ((app_4 (syntax-props s_0))) - (syntax2.1 - content*8_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s_0)))))))) + (syntax2.1 + content*8_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + (syntax-props s_0) + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" @@ -10038,20 +9989,14 @@ (if new-p_0 (modified-content1.1 content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 - (syntax-shifted-multi-scopes s_0))) - (let ((app_2 (syntax-mpi-shifts s_0))) - (let ((app_3 (syntax-srcloc s_0))) - (let ((app_4 (syntax-props s_0))) - (syntax2.1 - content*9_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s_0)))))))) + (syntax2.1 + content*9_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + (syntax-props s_0) + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" @@ -10085,19 +10030,14 @@ (if new-p_0 (modified-content1.1 content_0 new-p_0) content_0)))) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-shifted-multi-scopes s_0))) - (let ((app_2 (syntax-mpi-shifts s_0))) - (let ((app_3 (syntax-srcloc s_0))) - (let ((app_4 (syntax-props s_0))) - (syntax2.1 - content*10_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (syntax-inspector s_0)))))))) + (syntax2.1 + content*10_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + (syntax-props s_0) + (syntax-inspector s_0))) (raise-argument-error 'struct-copy "syntax?" s_0))))))))))) (define any-superior? (lambda (t_0 from-i_0) @@ -10764,8 +10704,9 @@ (define deserialize-multi-scope (lambda (name_0 scopes_0) (let ((app_0 (new-deserialize-scope-id!))) - (let ((app_1 (box (hasheqv)))) - (multi-scope3.1 app_0 name_0 (box scopes_0) app_1 (box (hash))))))) + (let ((app_1 (box scopes_0))) + (let ((app_2 (box (hasheqv)))) + (multi-scope3.1 app_0 name_0 app_1 app_2 (box (hash)))))))) (define struct:representative-scope (make-record-type-descriptor* 'representative-scope @@ -11109,12 +11050,8 @@ (hash-set scopes_0 phase_0 s_0))) s_0 (multi-scope-to-scope-at-phase ms_0 phase_0)))))))) -(define scope>? - (lambda (sc1_0 sc2_0) - (let ((app_0 (scope-id sc1_0))) (> app_0 (scope-id sc2_0))))) -(define scope? (lambda (sc1_0 sc2_0) (> (scope-id sc1_0) (scope-id sc2_0)))) +(define scope app_0 (scope-id max-sc_0)))) + (> (scope-id sc_0) (scope-id max-sc_0))) sc_0 max-sc_0))) (values max-sc_1)))) @@ -12968,16 +12788,16 @@ (lambda (shadow-except19_0 scopes21_0 bulk-binding22_0) (begin (let ((max-sc_0 (find-max-scope scopes21_0))) - (let ((bt_0 - (let ((temp81_0 (scope-binding-table max-sc_0))) + (let ((temp81_0 (scope-binding-table max-sc_0))) + (let ((bt_0 (binding-table-add-bulk.1 shadow-except19_0 temp81_0 scopes21_0 - bulk-binding22_0)))) - (begin - (set-scope-binding-table! max-sc_0 bt_0) - (clear-resolve-cache!)))))))) + bulk-binding22_0))) + (begin + (set-scope-binding-table! max-sc_0 bt_0) + (clear-resolve-cache!))))))))) (define syntax-any-macro-scopes? (lambda (s_0) (let ((ht_0 (syntax-scopes s_0))) @@ -12990,14 +12810,13 @@ (begin (if i_0 (let ((sc_0 (unsafe-immutable-hash-iterate-key ht_0 i_0))) - (let ((result_1 - (let ((result_1 (eq? (scope-kind sc_0) 'macro))) - (values result_1)))) - (if (if (not (let ((x_0 (list sc_0))) result_1)) #t #f) - (for-loop_0 - result_1 - (unsafe-immutable-hash-iterate-next ht_0 i_0)) - result_1))) + (let ((result_1 (eq? (scope-kind sc_0) 'macro))) + (let ((result_2 (values result_1))) + (if (if (not (let ((x_0 (list sc_0))) result_2)) #t #f) + (for-loop_0 + result_2 + (unsafe-immutable-hash-iterate-next ht_0 i_0)) + result_2)))) result_0)))))) (for-loop_0 #f (unsafe-immutable-hash-iterate-first ht_0))))))) (define resolve.1 @@ -13830,30 +13649,24 @@ (modified-content-scope-propagations+tamper content*_0) #f))) - (let ((app_1 (syntax-scopes s8_0))) - (let ((app_2 - (syntax-shifted-multi-scopes s8_0))) - (propagation-mpi-shift - app_0 - (lambda (s_0) (shift-cons shift_0 s_0)) - inspector7_0 - app_1 - app_2 - (syntax-mpi-shifts s8_0)))))) + (propagation-mpi-shift + app_0 + (lambda (s_0) (shift-cons shift_0 s_0)) + inspector7_0 + (syntax-scopes s8_0) + (syntax-shifted-multi-scopes s8_0) + (syntax-mpi-shifts s8_0)))) content*_0))) (let ((inspector63_1 inspector63_0) (mpi-shifts62_1 mpi-shifts62_0)) - (let ((app_0 (syntax-scopes s8_0))) - (let ((app_1 (syntax-shifted-multi-scopes s8_0))) - (let ((app_2 (syntax-srcloc s8_0))) - (syntax2.1 - content*64_0 - app_0 - app_1 - mpi-shifts62_1 - app_2 - (syntax-props s8_0) - inspector63_1)))))))) + (syntax2.1 + content*64_0 + (syntax-scopes s8_0) + (syntax-shifted-multi-scopes s8_0) + mpi-shifts62_1 + (syntax-srcloc s8_0) + (syntax-props s8_0) + inspector63_1))))) (raise-argument-error 'struct-copy "syntax?" s8_0)))))))))) (define shift-cons (lambda (shift_0 shifts_0) @@ -14161,41 +13974,34 @@ (modified-content-content content*_0) content*_0))) (if (syntax?$1 s_0) - (let ((inspector96_0 - (let ((or-part_0 (syntax-inspector s_0))) - (if or-part_0 or-part_0 insp_0)))) - (let ((content*97_0 - (if (datum-has-elements? content_0) - (modified-content1.1 - content_0 - (let ((app_0 - (if (modified-content? content*_0) - (modified-content-scope-propagations+tamper - content*_0) - #f))) - (let ((app_1 (syntax-scopes s_0))) - (let ((app_2 (syntax-shifted-multi-scopes s_0))) - (propagation-mpi-shift - app_0 - #f - insp_0 - app_1 - app_2 - (syntax-mpi-shifts s_0)))))) - content*_0))) - (let ((inspector96_1 inspector96_0)) - (let ((app_0 (syntax-scopes s_0))) - (let ((app_1 (syntax-shifted-multi-scopes s_0))) - (let ((app_2 (syntax-mpi-shifts s_0))) - (let ((app_3 (syntax-srcloc s_0))) - (syntax2.1 - content*97_0 - app_0 - app_1 - app_2 - app_3 - (syntax-props s_0) - inspector96_1)))))))) + (let ((or-part_0 (syntax-inspector s_0))) + (let ((inspector96_0 (if or-part_0 or-part_0 insp_0))) + (let ((content*97_0 + (if (datum-has-elements? content_0) + (modified-content1.1 + content_0 + (let ((app_0 + (if (modified-content? content*_0) + (modified-content-scope-propagations+tamper + content*_0) + #f))) + (propagation-mpi-shift + app_0 + #f + insp_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0)))) + content*_0))) + (let ((inspector96_1 inspector96_0)) + (syntax2.1 + content*97_0 + (syntax-scopes s_0) + (syntax-shifted-multi-scopes s_0) + (syntax-mpi-shifts s_0) + (syntax-srcloc s_0) + (syntax-props s_0) + inspector96_1))))) (raise-argument-error 'struct-copy "syntax?" s_0)))))) (define 1/syntax-source-module (let ((syntax-source-module_0 @@ -14280,19 +14086,14 @@ (let ((the-struct_0 (datum->syntax$1 #f (syntax-e$1 id_0) id_0 id_0))) (if (syntax?$1 the-struct_0) (let ((mpi-shifts98_0 (syntax-mpi-shifts id_0))) - (let ((app_0 (syntax-content* the-struct_0))) - (let ((app_1 (syntax-scopes the-struct_0))) - (let ((app_2 (syntax-shifted-multi-scopes the-struct_0))) - (let ((app_3 (syntax-srcloc the-struct_0))) - (let ((app_4 (syntax-props the-struct_0))) - (syntax2.1 - app_0 - app_1 - app_2 - mpi-shifts98_0 - app_3 - app_4 - (syntax-inspector the-struct_0)))))))) + (syntax2.1 + (syntax-content* the-struct_0) + (syntax-scopes the-struct_0) + (syntax-shifted-multi-scopes the-struct_0) + mpi-shifts98_0 + (syntax-srcloc the-struct_0) + (syntax-props the-struct_0) + (syntax-inspector the-struct_0))) (raise-argument-error 'struct-copy "syntax?" the-struct_0)))))))) (define struct:provided (make-record-type-descriptor* 'provided #f #f #f #f 3 0)) @@ -14373,7 +14174,7 @@ binding_0)))))))))) (define struct:bulk-binding (make-record-type-descriptor* 'bulk-binding #f #f #f #f 8 9)) -(define effect_2366 +(define effect_2831 (struct-type-install-properties! struct:bulk-binding 'bulk-binding @@ -14426,11 +14227,9 @@ b_0 (bulk-provide-self bulk-provide_0)) (let ((provides_0 - (let ((app_0 - (bulk-provide-provides bulk-provide_0))) - (hash-ref - app_0 - (bulk-binding-provide-phase-level b_0))))) + (hash-ref + (bulk-provide-provides bulk-provide_0) + (bulk-binding-provide-phase-level b_0)))) (let ((excepts_0 (bulk-binding-excepts b_0))) (let ((prefix_0 (bulk-binding-prefix b_0))) (let ((adjusted-provides_0 @@ -15364,7 +15163,8 @@ 'module-registry 'lock-box)))))) (define make-module-registry - (lambda () (module-registry1.1 (make-hasheq) (box #f)))) + (lambda () + (let ((app_0 (make-hasheq))) (module-registry1.1 app_0 (box #f))))) (define registry-call-with-lock (lambda (r_0 proc_0) (let ((lock-box_0 (module-registry-lock-box r_0))) @@ -15538,64 +15338,65 @@ root-expand-ctx3_0))) (let ((phase_0 (if share-from-ns7_0 (namespace-phase share-from-ns7_0) 0))) - (let ((ns_0 - (let ((app_0 (make-small-hasheqv))) + (let ((app_0 (box root-expand-ctx_0))) + (let ((ns_0 (let ((app_1 (make-small-hasheqv))) - (let ((app_2 - (if share-from-ns7_0 - (namespace-module-registry$1 share-from-ns7_0) - (make-module-registry)))) + (let ((app_2 (make-small-hasheqv))) (let ((app_3 (if share-from-ns7_0 - (namespace-bulk-binding-registry - share-from-ns7_0) - (make-bulk-binding-registry)))) - (let ((app_4 (make-small-hasheq))) - (let ((app_5 - (if share-from-ns7_0 - (let ((or-part_0 - (namespace-root-namespace - share-from-ns7_0))) - (if or-part_0 - or-part_0 - share-from-ns7_0)) - #f))) + (namespace-module-registry$1 share-from-ns7_0) + (make-module-registry)))) + (let ((app_4 + (if share-from-ns7_0 + (namespace-bulk-binding-registry + share-from-ns7_0) + (make-bulk-binding-registry)))) + (let ((app_5 (make-small-hasheq))) (let ((app_6 - (make-inspector - (current-code-inspector)))) + (if share-from-ns7_0 + (let ((or-part_0 + (namespace-root-namespace + share-from-ns7_0))) + (if or-part_0 + or-part_0 + share-from-ns7_0)) + #f))) (let ((app_7 - (if share-from-ns7_0 - (namespace-available-module-instances - share-from-ns7_0) - (make-hasheqv)))) - (namespace1.1 - top-level-module-path-index - #f - (box root-expand-ctx_0) - phase_0 - phase_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - #f - app_6 - app_7 - (if share-from-ns7_0 - (namespace-module-instances - share-from-ns7_0) - (make-hasheqv))))))))))))) - (begin - (if register?4_0 - (let ((small-ht_0 (namespace-phase-to-namespace ns_0))) - (begin-unsafe - (set-box! - small-ht_0 - (hash-set (unbox small-ht_0) phase_0 ns_0)))) - (void)) - ns_0)))))))) + (make-inspector + (current-code-inspector)))) + (let ((app_8 + (if share-from-ns7_0 + (namespace-available-module-instances + share-from-ns7_0) + (make-hasheqv)))) + (namespace1.1 + top-level-module-path-index + #f + app_0 + phase_0 + phase_0 + app_1 + app_2 + app_3 + app_4 + app_5 + app_6 + #f + app_7 + app_8 + (if share-from-ns7_0 + (namespace-module-instances + share-from-ns7_0) + (make-hasheqv))))))))))))) + (begin + (if register?4_0 + (let ((small-ht_0 (namespace-phase-to-namespace ns_0))) + (begin-unsafe + (set-box! + small-ht_0 + (hash-set (unbox small-ht_0) phase_0 ns_0)))) + (void)) + ns_0))))))))) (define 1/current-namespace (make-parameter (make-namespace) @@ -15629,76 +15430,49 @@ mpi_0)))) (define namespace->module (lambda (ns_0 name_0) - (let ((or-part_0 - (let ((small-ht_0 (namespace-submodule-declarations ns_0))) - (begin-unsafe (hash-ref (unbox small-ht_0) name_0 #f))))) - (if or-part_0 - or-part_0 - (hash-ref - (module-registry-declarations (namespace-module-registry$1 ns_0)) - name_0 - #f))))) + (let ((small-ht_0 (namespace-submodule-declarations ns_0))) + (let ((or-part_0 (begin-unsafe (hash-ref (unbox small-ht_0) name_0 #f)))) + (if or-part_0 + or-part_0 + (hash-ref + (module-registry-declarations (namespace-module-registry$1 ns_0)) + name_0 + #f)))))) (define namespace->namespace-at-phase (lambda (ns_0 phase_0) - (let ((or-part_0 - (let ((small-ht_0 (namespace-phase-to-namespace ns_0))) - (begin-unsafe (hash-ref (unbox small-ht_0) phase_0 #f))))) - (if or-part_0 - or-part_0 - (let ((p-ns_0 - (if (1/namespace? ns_0) - (let ((root-namespace18_0 - (let ((or-part_1 (namespace-root-namespace ns_0))) - (if or-part_1 or-part_1 ns_0)))) - (let ((app_0 (namespace-mpi ns_0))) - (let ((app_1 (namespace-source-name ns_0))) - (let ((app_2 (namespace-root-expand-ctx ns_0))) - (let ((app_3 (namespace-0-phase ns_0))) - (let ((app_4 (namespace-phase-to-namespace ns_0))) - (let ((app_5 - (namespace-phase-level-to-definitions - ns_0))) - (let ((app_6 - (namespace-module-registry$1 ns_0))) - (let ((app_7 - (namespace-bulk-binding-registry - ns_0))) - (let ((app_8 - (namespace-submodule-declarations - ns_0))) - (let ((app_9 - (namespace-declaration-inspector - ns_0))) - (let ((app_10 - (namespace-inspector ns_0))) - (let ((app_11 - (namespace-available-module-instances - ns_0))) - (namespace1.1 - app_0 - app_1 - app_2 - phase_0 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - root-namespace18_0 - app_9 - app_10 - app_11 - (namespace-module-instances - ns_0))))))))))))))) - (raise-argument-error 'struct-copy "namespace?" ns_0)))) - (begin - (let ((small-ht_0 (namespace-phase-to-namespace ns_0))) - (begin-unsafe - (set-box! - small-ht_0 - (hash-set (unbox small-ht_0) phase_0 p-ns_0)))) - p-ns_0)))))) + (let ((small-ht_0 (namespace-phase-to-namespace ns_0))) + (let ((or-part_0 + (begin-unsafe (hash-ref (unbox small-ht_0) phase_0 #f)))) + (if or-part_0 + or-part_0 + (let ((p-ns_0 + (if (1/namespace? ns_0) + (let ((or-part_1 (namespace-root-namespace ns_0))) + (let ((root-namespace18_0 (if or-part_1 or-part_1 ns_0))) + (namespace1.1 + (namespace-mpi ns_0) + (namespace-source-name ns_0) + (namespace-root-expand-ctx ns_0) + phase_0 + (namespace-0-phase ns_0) + (namespace-phase-to-namespace ns_0) + (namespace-phase-level-to-definitions ns_0) + (namespace-module-registry$1 ns_0) + (namespace-bulk-binding-registry ns_0) + (namespace-submodule-declarations ns_0) + root-namespace18_0 + (namespace-declaration-inspector ns_0) + (namespace-inspector ns_0) + (namespace-available-module-instances ns_0) + (namespace-module-instances ns_0)))) + (raise-argument-error 'struct-copy "namespace?" ns_0)))) + (begin + (let ((small-ht_1 (namespace-phase-to-namespace ns_0))) + (begin-unsafe + (set-box! + small-ht_1 + (hash-set (unbox small-ht_1) phase_0 p-ns_0)))) + p-ns_0))))))) (define namespace->name (lambda (ns_0) (let ((n_0 (namespace-source-name ns_0))) @@ -15720,25 +15494,26 @@ s_0)))))) (define namespace->definitions (lambda (ns_0 phase-level_0) - (let ((d_0 - (let ((small-ht_0 (namespace-phase-level-to-definitions ns_0))) - (begin-unsafe (hash-ref (unbox small-ht_0) phase-level_0 #f))))) - (if d_0 - d_0 - (let ((p-ns_0 - (namespace->namespace-at-phase - ns_0 - (phase+ (namespace-0-phase ns_0) phase-level_0)))) - (let ((d_1 - (let ((app_0 (make-instance (namespace->name p-ns_0) p-ns_0))) - (definitions2.1 app_0 (make-hasheq))))) - (begin - (let ((small-ht_0 (namespace-phase-level-to-definitions ns_0))) - (begin-unsafe - (set-box! - small-ht_0 - (hash-set (unbox small-ht_0) phase-level_0 d_1)))) - d_1))))))) + (let ((small-ht_0 (namespace-phase-level-to-definitions ns_0))) + (let ((d_0 + (begin-unsafe (hash-ref (unbox small-ht_0) phase-level_0 #f)))) + (if d_0 + d_0 + (let ((p-ns_0 + (namespace->namespace-at-phase + ns_0 + (phase+ (namespace-0-phase ns_0) phase-level_0)))) + (let ((d_1 + (let ((app_0 + (make-instance (namespace->name p-ns_0) p-ns_0))) + (definitions2.1 app_0 (make-hasheq))))) + (begin + (let ((small-ht_1 (namespace-phase-level-to-definitions ns_0))) + (begin-unsafe + (set-box! + small-ht_1 + (hash-set (unbox small-ht_1) phase-level_0 d_1)))) + d_1)))))))) (define namespace-set-variable! (let ((namespace-set-variable!_0 (|#%name| @@ -15863,44 +15638,27 @@ old-props_0 'origin origin_0))) - (let ((app_0 (syntax-content* new-stx2_0))) - (let ((app_1 (syntax-scopes new-stx2_0))) - (let ((app_2 - (syntax-shifted-multi-scopes - new-stx2_0))) - (let ((app_3 - (syntax-mpi-shifts new-stx2_0))) - (let ((app_4 - (syntax-srcloc new-stx2_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - props4_0 - (syntax-inspector - new-stx2_0)))))))) + (syntax2.1 + (syntax-content* new-stx2_0) + (syntax-scopes new-stx2_0) + (syntax-shifted-multi-scopes new-stx2_0) + (syntax-mpi-shifts new-stx2_0) + (syntax-srcloc new-stx2_0) + props4_0 + (syntax-inspector new-stx2_0))) (raise-argument-error 'struct-copy "syntax?" new-stx2_0)))) (if (syntax?$1 new-stx2_0) - (let ((app_0 (syntax-content* new-stx2_0))) - (let ((app_1 (syntax-scopes new-stx2_0))) - (let ((app_2 - (syntax-shifted-multi-scopes - new-stx2_0))) - (let ((app_3 (syntax-mpi-shifts new-stx2_0))) - (let ((app_4 (syntax-srcloc new-stx2_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - old-props_0 - (syntax-inspector new-stx2_0))))))) + (syntax2.1 + (syntax-content* new-stx2_0) + (syntax-scopes new-stx2_0) + (syntax-shifted-multi-scopes new-stx2_0) + (syntax-mpi-shifts new-stx2_0) + (syntax-srcloc new-stx2_0) + old-props_0 + (syntax-inspector new-stx2_0)) (raise-argument-error 'struct-copy "syntax?" @@ -16016,22 +15774,14 @@ (unsafe-immutable-hash-iterate-first new-props_0))))))) (if (syntax?$1 new-stx2_0) - (let ((app_0 (syntax-content* new-stx2_0))) - (let ((app_1 (syntax-scopes new-stx2_0))) - (let ((app_2 - (syntax-shifted-multi-scopes - new-stx2_0))) - (let ((app_3 - (syntax-mpi-shifts new-stx2_0))) - (let ((app_4 (syntax-srcloc new-stx2_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - updated-props_0 - (syntax-inspector new-stx2_0))))))) + (syntax2.1 + (syntax-content* new-stx2_0) + (syntax-scopes new-stx2_0) + (syntax-shifted-multi-scopes new-stx2_0) + (syntax-mpi-shifts new-stx2_0) + (syntax-srcloc new-stx2_0) + updated-props_0 + (syntax-inspector new-stx2_0)) (raise-argument-error 'struct-copy "syntax?" @@ -16586,7 +16336,7 @@ (lambda (proc_0) (set! current-previously-unbound proc_0))) (define struct:module-use (make-record-type-descriptor* 'module-use #f #f #f #f 2 0)) -(define effect_2861 +(define effect_2381 (struct-type-install-properties! struct:module-use 'module-use @@ -16601,8 +16351,10 @@ (let ((a-mod_0 (module-use-module a_0))) (let ((b-mod_0 (module-use-module b_0))) (if (|#%app| eql?_0 a-mod_0 b-mod_0) - (if (let ((app_0 (module-use-phase a_0))) - (|#%app| eql?_0 app_0 (module-use-phase b_0))) + (if (|#%app| + eql?_0 + (module-use-phase a_0) + (module-use-phase b_0)) (call-with-values (lambda () (1/module-path-index-split a-mod_0)) (case-lambda @@ -16616,10 +16368,9 @@ a-path_1 (if b-path_0 b-path_0 - (let ((app_0 (module-path-index-resolved a-mod_0))) - (eq? - app_0 - (module-path-index-resolved b-mod_0))))))) + (eq? + (module-path-index-resolved a-mod_0) + (module-path-index-resolved b-mod_0)))))) (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 2 args)))) #f) @@ -16913,7 +16664,8 @@ (record-mutator struct:module-instance 5))) (define make-module-instance (lambda (m-ns_0 m_0) - (module-instance40.1 m-ns_0 m_0 #f (make-small-hasheqv) #f #f (box #f)))) + (let ((app_0 (make-small-hasheqv))) + (module-instance40.1 m-ns_0 m_0 #f app_0 #f #f (box #f))))) (define make-module-namespace.1 (|#%name| make-module-namespace @@ -16941,40 +16693,23 @@ (submodule-declarations134_1 submodule-declarations134_0) (source-name131_1 source-name131_0)) - (let ((app_0 - (namespace-root-expand-ctx - the-struct_0))) - (let ((app_1 - (namespace-phase-to-namespace - the-struct_0))) - (let ((app_2 - (namespace-phase-level-to-definitions - the-struct_0))) - (let ((app_3 - (namespace-module-registry$1 - the-struct_0))) - (let ((app_4 - (namespace-bulk-binding-registry - the-struct_0))) - (let ((app_5 - (namespace-root-namespace - the-struct_0))) - (namespace1.1 - mpi41_0 - source-name131_1 - app_0 - 0 - 0 - app_1 - app_2 - app_3 - app_4 - submodule-declarations134_1 - app_5 - declaration-inspector137_0 - (namespace-inspector the-struct_0) - available-module-instances135_1 - module-instances136_1))))))))))))) + (namespace1.1 + mpi41_0 + source-name131_1 + (namespace-root-expand-ctx the-struct_0) + 0 + 0 + (namespace-phase-to-namespace the-struct_0) + (namespace-phase-level-to-definitions + the-struct_0) + (namespace-module-registry$1 the-struct_0) + (namespace-bulk-binding-registry the-struct_0) + submodule-declarations134_1 + (namespace-root-namespace the-struct_0) + declaration-inspector137_0 + (namespace-inspector the-struct_0) + available-module-instances135_1 + module-instances136_1))))))) (raise-argument-error 'struct-copy "namespace?" @@ -17035,14 +16770,11 @@ (namespace-bulk-binding-registry ns51_0))) (let ((self_0 (module-self m52_0))) (let ((provides_0 (module-provides m52_0))) - (let ((self_1 self_0) - (bulk-binding-registry_1 bulk-binding-registry_0)) - (begin-unsafe - (hash-set! - (bulk-binding-registry-table - bulk-binding-registry_1) - mod-name53_0 - (bulk-provide13.1 self_1 provides_0))))))) + (begin-unsafe + (hash-set! + (bulk-binding-registry-table bulk-binding-registry_0) + mod-name53_0 + (bulk-provide13.1 self_0 provides_0)))))) (|#%app| (|#%app| 1/current-module-name-resolver) mod-name53_0 @@ -17135,8 +16867,11 @@ (lambda (ns_0 name_0 phase-level_0) (let ((m_0 (namespace->module ns_0 name_0))) (if m_0 - (let ((app_0 (module-phase-level-linklet-info-callback m_0))) - (|#%app| app_0 phase-level_0 ns_0 (module-inspector m_0))) + (|#%app| + (module-phase-level-linklet-info-callback m_0) + phase-level_0 + ns_0 + (module-inspector m_0)) #f)))) (define module-name->error-string (lambda (mod-name_0) (unquoted-printing-string (format "~a" mod-name_0)))) @@ -17161,23 +16896,21 @@ #f))) (if or-part_0 or-part_0 - (let ((or-part_1 - (let ((c-ns_0 - (let ((or-part_1 - (namespace-root-namespace ns61_0))) - (if or-part_1 or-part_1 ns61_0)))) - (hash-ref - (namespace-module-instances c-ns_0) - name62_0 - #f)))) - (if or-part_1 - or-part_1 - (if complain-on-failure?55_0 - (error - "no module instance found:" - name62_0 - 0-phase63_0) - #f))))))) + (let ((or-part_1 (namespace-root-namespace ns61_0))) + (let ((or-part_2 + (let ((c-ns_0 (if or-part_1 or-part_1 ns61_0))) + (hash-ref + (namespace-module-instances c-ns_0) + name62_0 + #f)))) + (if or-part_2 + or-part_2 + (if complain-on-failure?55_0 + (error + "no module instance found:" + name62_0 + 0-phase63_0) + #f)))))))) (if (if mi_0 check-available-at-phase-level56_0 #f) (check-availablilty mi_0 @@ -17218,36 +16951,22 @@ root-expand-ctx152_0) (source-name151_1 source-name151_0) (mpi150_1 mpi150_0)) - (let ((app_0 - (namespace-module-registry$1 ns_0))) - (let ((app_1 - (namespace-bulk-binding-registry - ns_0))) - (let ((app_2 - (namespace-submodule-declarations - ns_0))) - (let ((app_3 - (namespace-root-namespace ns_0))) - (let ((app_4 - (namespace-available-module-instances - ns_0))) - (namespace1.1 - mpi150_1 - source-name151_1 - root-expand-ctx152_1 - phase153_1 - 0-phase154_1 - phase-to-namespace155_1 - phase-level-to-definitions156_1 - app_0 - app_1 - app_2 - app_3 - declaration-inspector157_1 - inspector158_0 - app_4 - (namespace-module-instances - ns_0))))))))))))))))) + (namespace1.1 + mpi150_1 + source-name151_1 + root-expand-ctx152_1 + phase153_1 + 0-phase154_1 + phase-to-namespace155_1 + phase-level-to-definitions156_1 + (namespace-module-registry$1 ns_0) + (namespace-bulk-binding-registry ns_0) + (namespace-submodule-declarations ns_0) + (namespace-root-namespace ns_0) + declaration-inspector157_1 + inspector158_0 + (namespace-available-module-instances ns_0) + (namespace-module-instances ns_0)))))))))))) (raise-argument-error 'struct-copy "namespace?" ns_0)))) (let ((mi_0 (make-module-instance m-ns_0 m_0))) (begin @@ -17331,53 +17050,44 @@ (lambda (ns_0 name_0 0-phase_0 m_0 mpi_0) (let ((m-ns_0 (if (1/namespace? ns_0) - (let ((source-name160_0 - (let ((or-part_0 (module-source-name m_0))) + (let ((or-part_0 (module-source-name m_0))) + (let ((source-name160_0 (if or-part_0 or-part_0 (resolved-module-path-root-name - (1/module-path-index-resolve mpi_0)))))) - (let ((root-expand-ctx161_0 (box #f))) - (let ((phase-to-namespace164_0 (make-small-hasheqv))) - (let ((phase-level-to-definitions165_0 - (make-small-hasheqv))) - (let ((declaration-inspector166_0 (module-inspector m_0))) - (let ((inspector167_0 - (make-inspector (module-inspector m_0)))) - (let ((declaration-inspector166_1 - declaration-inspector166_0) - (phase-level-to-definitions165_1 - phase-level-to-definitions165_0) - (phase-to-namespace164_1 - phase-to-namespace164_0) - (root-expand-ctx161_1 root-expand-ctx161_0) - (source-name160_1 source-name160_0)) - (let ((app_0 (namespace-module-registry$1 ns_0))) - (let ((app_1 - (namespace-bulk-binding-registry ns_0))) - (let ((app_2 - (namespace-submodule-declarations ns_0))) - (let ((app_3 (namespace-root-namespace ns_0))) - (let ((app_4 - (namespace-available-module-instances - ns_0))) - (namespace1.1 - mpi_0 - source-name160_1 - root-expand-ctx161_1 - 0-phase_0 - 0-phase_0 - phase-to-namespace164_1 - phase-level-to-definitions165_1 - app_0 - app_1 - app_2 - app_3 - declaration-inspector166_1 - inspector167_0 - app_4 - (namespace-module-instances - ns_0)))))))))))))) + (1/module-path-index-resolve mpi_0))))) + (let ((root-expand-ctx161_0 (box #f))) + (let ((phase-to-namespace164_0 (make-small-hasheqv))) + (let ((phase-level-to-definitions165_0 + (make-small-hasheqv))) + (let ((declaration-inspector166_0 + (module-inspector m_0))) + (let ((inspector167_0 + (make-inspector (module-inspector m_0)))) + (let ((declaration-inspector166_1 + declaration-inspector166_0) + (phase-level-to-definitions165_1 + phase-level-to-definitions165_0) + (phase-to-namespace164_1 + phase-to-namespace164_0) + (root-expand-ctx161_1 root-expand-ctx161_0) + (source-name160_1 source-name160_0)) + (namespace1.1 + mpi_0 + source-name160_1 + root-expand-ctx161_1 + 0-phase_0 + 0-phase_0 + phase-to-namespace164_1 + phase-level-to-definitions165_1 + (namespace-module-registry$1 ns_0) + (namespace-bulk-binding-registry ns_0) + (namespace-submodule-declarations ns_0) + (namespace-root-namespace ns_0) + declaration-inspector166_1 + inspector167_0 + (namespace-available-module-instances ns_0) + (namespace-module-instances ns_0)))))))))) (raise-argument-error 'struct-copy "namespace?" ns_0)))) (begin (let ((small-ht_0 (namespace-phase-to-namespace m-ns_0))) @@ -17448,8 +17158,9 @@ (set-module-instance-attached?! mi_0 #t)))) (define module-force-bulk-binding! (lambda (m_0 ns_0) - (let ((app_0 (module-force-bulk-binding m_0))) - (|#%app| app_0 (namespace-bulk-binding-registry ns_0))))) + (|#%app| + (module-force-bulk-binding m_0) + (namespace-bulk-binding-registry ns_0)))) (define namespace-module-instantiate!.1 (|#%name| namespace-module-instantiate! @@ -17877,17 +17588,15 @@ (cons mi111_0 l_0)))) - (let ((ht_1 - ht_0)) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - ht_1 - phase_0 - xform_0 - null))))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + ht_0 + phase_0 + xform_0 + null)))) (let ((small-ht_0 (module-instance-phase-level-to-state mi111_0))) @@ -18005,10 +17714,9 @@ (namespace-run-available-modules!_0 ns_0 run-phase116_0))))) (define namespace-primitive-module-visit! (lambda (ns_0 name_0) - (let ((mi_0 - (let ((app_0 (namespace-module-instances ns_0))) - (hash-ref app_0 (1/make-resolved-module-path name_0))))) - (run-module-instance!.1 #t 1 hash2610 null #f mi_0 ns_0)))) + (let ((app_0 (namespace-module-instances ns_0))) + (let ((mi_0 (hash-ref app_0 (1/make-resolved-module-path name_0)))) + (run-module-instance!.1 #t 1 hash2610 null #f mi_0 ns_0))))) (define namespace-module-use->module+linklet-instances.1 (|#%name| namespace-module-use->module+linklet-instances @@ -18032,31 +17740,29 @@ temp215_0 phase-shift120_0)))) (let ((m-ns_0 (module-instance-namespace mi_0))) - (let ((d_0 - (let ((small-ht_0 - (namespace-phase-level-to-definitions m-ns_0))) + (let ((small-ht_0 (namespace-phase-level-to-definitions m-ns_0))) + (let ((d_0 (let ((key_0 (module-use-phase mu125_0))) - (let ((small-ht_1 small-ht_0)) - (begin-unsafe - (hash-ref (unbox small-ht_1) key_0 #f))))))) - (if d_0 - (values mi_0 (definitions-variables d_0)) - (let ((app_0 - (string-append - "namespace mismatch: phase level not found;\n" - " module: ~a\n" - " phase level: ~a\n" - " found phase levels: ~a"))) - (let ((app_1 (module-use-phase mu125_0))) - (error - 'eval - app_0 - mod_0 - app_1 - (let ((small-ht_0 - (namespace-phase-level-to-definitions m-ns_0))) (begin-unsafe - (hash-keys (unbox small-ht_0)))))))))))))))) + (hash-ref (unbox small-ht_0) key_0 #f))))) + (if d_0 + (values mi_0 (definitions-variables d_0)) + (let ((app_0 + (string-append + "namespace mismatch: phase level not found;\n" + " module: ~a\n" + " phase level: ~a\n" + " found phase levels: ~a"))) + (let ((app_1 (module-use-phase mu125_0))) + (error + 'eval + app_0 + mod_0 + app_1 + (let ((small-ht_1 + (namespace-phase-level-to-definitions m-ns_0))) + (begin-unsafe + (hash-keys (unbox small-ht_1))))))))))))))))) (define unresolve-requires (lambda (requires_0) (reverse$1 @@ -18112,8 +17818,8 @@ (for-loop_0 null requires_0)))))) (define module-compute-access! (lambda (m_0) - (let ((access_0 - (let ((ht_0 (module-provides m_0))) + (let ((ht_0 (module-provides m_0))) + (let ((access_0 (begin (letrec* ((for-loop_0 @@ -18202,8 +17908,8 @@ (hash-iterate-next ht_0 i_0)))) (args (raise-binding-result-arity-error 2 args)))) table_0)))))) - (for-loop_0 hash2589 (hash-iterate-first ht_0))))))) - (begin (set-module-access! m_0 access_0) access_0)))) + (for-loop_0 hash2589 (hash-iterate-first ht_0)))))) + (begin (set-module-access! m_0 access_0) access_0))))) (define module-instances->indented-module-names (lambda (mi_0 seen-list_0) (let ((mi->name_0 @@ -18289,63 +17995,63 @@ (lambda (b_0 mi_0 id_0 in-s_0 what_0) (let ((m_0 (module-instance-module mi_0))) (if (if m_0 (not (module-no-protected? m_0)) #f) - (let ((access_0 - (let ((or-part_0 (module-access m_0))) - (if or-part_0 or-part_0 (module-compute-access! m_0))))) - (let ((a_0 - (let ((app_0 - (hash-ref - access_0 - (module-binding-phase b_0) - hash2610))) - (hash-ref app_0 (module-binding-sym b_0) 'unexported)))) - (if (let ((or-part_0 (eq? a_0 'unexported))) - (if or-part_0 or-part_0 (eq? a_0 'protected))) - (begin - (if (let ((or-part_0 - (let ((app_0 - (let ((or-part_0 (syntax-inspector id_0))) - (if or-part_0 - or-part_0 - (current-code-inspector))))) - (inspector-superior? - app_0 - (namespace-inspector - (module-instance-namespace mi_0)))))) - (if or-part_0 - or-part_0 - (if (module-binding-extra-inspector b_0) - (let ((app_0 (module-binding-extra-inspector b_0))) - (inspector-superior? - app_0 - (namespace-inspector - (module-instance-namespace mi_0)))) - #f))) - (void) - (let ((complain-id_0 - (let ((c-id_0 - (if in-s_0 in-s_0 (module-binding-sym b_0)))) - (if (not - (let ((app_0 - (if (syntax?$1 c-id_0) - (syntax-content c-id_0) - c-id_0))) - (eq? app_0 (syntax-content id_0)))) - c-id_0 - #f)))) - (raise-syntax-error$1 - #f - (format - "access disallowed by code inspector to ~a ~a\n from module: ~a" - a_0 - what_0 - (1/module-path-index-resolve - (namespace-mpi (module-instance-namespace mi_0)))) - complain-id_0 - id_0 - null))) - #t) - #f))) + (let ((or-part_0 (module-access m_0))) + (let ((access_0 + (if or-part_0 or-part_0 (module-compute-access! m_0)))) + (let ((a_0 + (let ((app_0 + (hash-ref + access_0 + (module-binding-phase b_0) + hash2610))) + (hash-ref app_0 (module-binding-sym b_0) 'unexported)))) + (if (let ((or-part_1 (eq? a_0 'unexported))) + (if or-part_1 or-part_1 (eq? a_0 'protected))) + (begin + (if (let ((or-part_1 + (let ((app_0 + (let ((or-part_1 (syntax-inspector id_0))) + (if or-part_1 + or-part_1 + (current-code-inspector))))) + (inspector-superior? + app_0 + (namespace-inspector + (module-instance-namespace mi_0)))))) + (if or-part_1 + or-part_1 + (if (module-binding-extra-inspector b_0) + (let ((app_0 (module-binding-extra-inspector b_0))) + (inspector-superior? + app_0 + (namespace-inspector + (module-instance-namespace mi_0)))) + #f))) + (void) + (let ((complain-id_0 + (let ((c-id_0 + (if in-s_0 in-s_0 (module-binding-sym b_0)))) + (if (not + (let ((app_0 + (if (syntax?$1 c-id_0) + (syntax-content c-id_0) + c-id_0))) + (eq? app_0 (syntax-content id_0)))) + c-id_0 + #f)))) + (raise-syntax-error$1 + #f + (format + "access disallowed by code inspector to ~a ~a\n from module: ~a" + a_0 + what_0 + (1/module-path-index-resolve + (namespace-mpi (module-instance-namespace mi_0)))) + complain-id_0 + id_0 + null))) + #t) + #f)))) #f)))) (define resolve+shift/extra-inspector (lambda (id_0 phase_0 ns_0) @@ -18448,7 +18154,7 @@ (define 1/make-set!-transformer (let ((struct:set!-transformer_0 (make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0))) - (let ((effect2392 + (let ((effect720 (struct-type-install-properties! struct:set!-transformer_0 'set!-transformer @@ -19318,65 +19024,52 @@ (root-expand-context/outer-frame-id root-ctx_0)))) (let ((declared-submodule-names_0 hash2610)) - (let ((binding-layer_1 binding-layer_0) - (phase_1 phase_0) - (lift-key_1 lift-key_0) - (counter_1 counter_0) - (frame-id_1 frame-id_0) - (defined-syms_1 defined-syms_0) - (use-site-scopes_1 use-site-scopes_0) - (all-scopes-stx_1 all-scopes-stx_0) - (top-level-bind-scope_1 - top-level-bind-scope_0) - (post-expansion_1 post-expansion_0) - (module-scopes_1 module-scopes_0) - (self-mpi_1 self-mpi_0)) - (begin-unsafe - (expand-context/outer1.1 - (expand-context/inner2.1 - self-mpi_1 - module-scopes_1 - top-level-bind-scope_1 - all-scopes-stx_1 - defined-syms_1 - counter_1 - lift-key_1 - to-parsed?3_0 - phase_1 - ns13_0 - #f - #f - #t - #f - #f - empty-free-id-set - declared-submodule-names_0 - #f - '() - #f - #f - #f - #f - observer6_0 - for-serializable?4_0 - to-correlated-linklet?5_0 - to-correlated-linklet?5_0 - #f - skip-visit-available?7_0) - post-expansion_1 - use-site-scopes_1 - frame-id_1 - 'top-level - empty-env - null - #f - binding-layer_1 - null - #f - #f - null - null - #f))))))))))))))))))))) + (begin-unsafe + (expand-context/outer1.1 + (expand-context/inner2.1 + self-mpi_0 + module-scopes_0 + top-level-bind-scope_0 + all-scopes-stx_0 + defined-syms_0 + counter_0 + lift-key_0 + to-parsed?3_0 + phase_0 + ns13_0 + #f + #f + #t + #f + #f + empty-free-id-set + declared-submodule-names_0 + #f + '() + #f + #f + #f + #f + observer6_0 + for-serializable?4_0 + to-correlated-linklet?5_0 + to-correlated-linklet?5_0 + #f + skip-visit-available?7_0) + post-expansion_0 + use-site-scopes_0 + frame-id_0 + 'top-level + empty-env + null + #f + binding-layer_0 + null + #f + #f + null + null + #f)))))))))))))))))))) (define copy-root-expand-context (lambda (ctx_0 root-ctx_0) (if (expand-context/outer? ctx_0) @@ -19431,110 +19124,58 @@ (root-expand-context/inner-lift-key (root-expand-context/outer-inner root-ctx_0))))) - (let ((counter35_1 counter35_0) - (defined-syms34_1 - defined-syms34_0) - (all-scopes-stx33_1 - all-scopes-stx33_0) - (top-level-bind-scope32_1 - top-level-bind-scope32_0) - (module-scopes31_1 - module-scopes31_0) - (self-mpi30_1 self-mpi30_0)) - (let ((app_0 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_1 - (expand-context/inner-phase - the-struct_0))) - (let ((app_2 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_3 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_4 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_5 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_6 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_7 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_8 - (expand-context/inner-stops - the-struct_0))) - (let ((app_9 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_10 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_11 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_12 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_13 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_14 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_15 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_16 - (expand-context/inner-observer - the-struct_0))) - (let ((app_17 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_18 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_19 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_20 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - self-mpi30_1 - module-scopes31_1 - top-level-bind-scope32_1 - all-scopes-stx33_1 - defined-syms34_1 - counter35_1 - lift-key36_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))))) + (expand-context/inner2.1 + self-mpi30_0 + module-scopes31_0 + top-level-bind-scope32_0 + all-scopes-stx33_0 + defined-syms34_0 + counter35_0 + lift-key36_0 + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))))))))) (raise-argument-error 'struct-copy "expand-context/inner?" @@ -19543,43 +19184,22 @@ (frame-id27_1 frame-id27_0) (use-site-scopes26_1 use-site-scopes26_0) (post-expansion25_1 post-expansion25_0)) - (let ((app_0 (expand-context/outer-context ctx_0))) - (let ((app_1 (expand-context/outer-env ctx_0))) - (let ((app_2 (expand-context/outer-scopes ctx_0))) - (let ((app_3 - (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_4 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_5 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_6 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_7 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_8 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner29_0 - post-expansion25_1 - use-site-scopes26_1 - frame-id27_1 - app_0 - app_1 - app_2 - app_3 - binding-layer28_1 - app_4 - app_5 - app_6 - app_7 - app_8 - (expand-context/outer-name - ctx_0))))))))))))))))) + (expand-context/outer1.1 + inner29_0 + post-expansion25_1 + use-site-scopes26_1 + frame-id27_1 + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + binding-layer28_1 + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + (expand-context/outer-name ctx_0)))))))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0)))) (define default-val.1$1 #f) (define current-expand-context @@ -19622,38 +19242,22 @@ ctx_0 (if (expand-context/outer? ctx_0) (let ((inner40_0 (root-expand-context/outer-inner ctx_0))) - (let ((app_0 (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_1 (root-expand-context/outer-frame-id ctx_0))) - (let ((app_2 (expand-context/outer-env ctx_0))) - (let ((app_3 (expand-context/outer-scopes ctx_0))) - (let ((app_4 (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_5 (expand-context/outer-binding-layer ctx_0))) - (let ((app_6 - (expand-context/outer-reference-records ctx_0))) - (let ((app_7 - (expand-context/outer-only-immediate? ctx_0))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (expand-context/outer1.1 - inner40_0 - #f - app_0 - app_1 - 'expression - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - (expand-context/outer-current-use-scopes ctx_0) - #f)))))))))))) + (expand-context/outer1.1 + inner40_0 + #f + (root-expand-context/outer-use-site-scopes ctx_0) + (root-expand-context/outer-frame-id ctx_0) + 'expression + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + #f)) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0))))) (define as-begin-expression-context (lambda (ctx_0) @@ -19661,45 +19265,22 @@ ctx_0 (if (expand-context/outer? ctx_0) (let ((inner42_0 (root-expand-context/outer-inner ctx_0))) - (let ((app_0 (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_1 (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_2 (root-expand-context/outer-frame-id ctx_0))) - (let ((app_3 (expand-context/outer-context ctx_0))) - (let ((app_4 (expand-context/outer-env ctx_0))) - (let ((app_5 (expand-context/outer-scopes ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (expand-context/outer1.1 - inner42_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-current-use-scopes - ctx_0) - #f)))))))))))))) + (expand-context/outer1.1 + inner42_0 + (root-expand-context/outer-post-expansion ctx_0) + (root-expand-context/outer-use-site-scopes ctx_0) + (root-expand-context/outer-frame-id ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + #f)) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0))))) (define as-tail-context.1 (|#%name| @@ -19710,51 +19291,22 @@ (if (expand-context/outer? ctx21_0) (let ((name43_0 (begin-unsafe (expand-context/outer-name wrt19_0)))) (let ((inner44_0 (root-expand-context/outer-inner ctx21_0))) - (let ((name43_1 name43_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion ctx21_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes ctx21_0))) - (let ((app_2 - (root-expand-context/outer-frame-id ctx21_0))) - (let ((app_3 (expand-context/outer-context ctx21_0))) - (let ((app_4 (expand-context/outer-env ctx21_0))) - (let ((app_5 (expand-context/outer-scopes ctx21_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx21_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx21_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx21_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx21_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx21_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx21_0))) - (expand-context/outer1.1 - inner44_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-current-use-scopes - ctx21_0) - name43_1)))))))))))))))) + (expand-context/outer1.1 + inner44_0 + (root-expand-context/outer-post-expansion ctx21_0) + (root-expand-context/outer-use-site-scopes ctx21_0) + (root-expand-context/outer-frame-id ctx21_0) + (expand-context/outer-context ctx21_0) + (expand-context/outer-env ctx21_0) + (expand-context/outer-scopes ctx21_0) + (expand-context/outer-def-ctx-scopes ctx21_0) + (expand-context/outer-binding-layer ctx21_0) + (expand-context/outer-reference-records ctx21_0) + (expand-context/outer-only-immediate? ctx21_0) + (expand-context/outer-need-eventually-defined ctx21_0) + (expand-context/outer-current-introduction-scopes ctx21_0) + (expand-context/outer-current-use-scopes ctx21_0) + name43_0))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx21_0)) ctx21_0))))) (define as-named-context @@ -19764,201 +19316,80 @@ (let ((name45_0 (car ids_0))) (let ((inner46_0 (root-expand-context/outer-inner ctx_0))) (let ((name45_1 name45_0)) - (let ((app_0 (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_2 (root-expand-context/outer-frame-id ctx_0))) - (let ((app_3 (expand-context/outer-context ctx_0))) - (let ((app_4 (expand-context/outer-env ctx_0))) - (let ((app_5 (expand-context/outer-scopes ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (expand-context/outer1.1 - inner46_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-current-use-scopes - ctx_0) - name45_1)))))))))))))))) + (expand-context/outer1.1 + inner46_0 + (root-expand-context/outer-post-expansion ctx_0) + (root-expand-context/outer-use-site-scopes ctx_0) + (root-expand-context/outer-frame-id ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + name45_1)))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0)) ctx_0))) (define as-to-parsed-context (lambda (ctx_0) (if (expand-context/outer? ctx_0) - (let ((inner47_0 - (let ((the-struct_0 (root-expand-context/outer-inner ctx_0))) + (let ((the-struct_0 (root-expand-context/outer-inner ctx_0))) + (let ((inner47_0 (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-phase - the-struct_0))) - (let ((app_8 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - #t - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - #f - app_22 - app_23 - app_24 - #t - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi the-struct_0) + (root-expand-context/inner-module-scopes the-struct_0) + (root-expand-context/inner-top-level-bind-scope the-struct_0) + (root-expand-context/inner-all-scopes-stx the-struct_0) + (root-expand-context/inner-defined-syms the-struct_0) + (root-expand-context/inner-counter the-struct_0) + (root-expand-context/inner-lift-key the-struct_0) + #t + (expand-context/inner-phase the-struct_0) + (expand-context/inner-namespace the-struct_0) + (expand-context/inner-just-once? the-struct_0) + (expand-context/inner-module-begin-k the-struct_0) + (expand-context/inner-allow-unbound? the-struct_0) + (expand-context/inner-in-local-expand? the-struct_0) + (|expand-context/inner-keep-#%expression?| the-struct_0) + (expand-context/inner-stops the-struct_0) + (expand-context/inner-declared-submodule-names the-struct_0) + (expand-context/inner-lifts the-struct_0) + (expand-context/inner-lift-envs the-struct_0) + (expand-context/inner-module-lifts the-struct_0) + (expand-context/inner-require-lifts the-struct_0) + (expand-context/inner-to-module-lifts the-struct_0) + (expand-context/inner-requires+provides the-struct_0) + #f + (expand-context/inner-for-serializable? the-struct_0) + (expand-context/inner-to-correlated-linklet? the-struct_0) + (expand-context/inner-normalize-locals? the-struct_0) + #t + (expand-context/inner-skip-visit-available? the-struct_0)) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_1 (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_2 (root-expand-context/outer-frame-id ctx_0))) - (let ((app_3 (expand-context/outer-context ctx_0))) - (let ((app_4 (expand-context/outer-env ctx_0))) - (let ((app_5 (expand-context/outer-scopes ctx_0))) - (let ((app_6 (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_7 (expand-context/outer-binding-layer ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner47_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx_0)))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner47_0 + (root-expand-context/outer-post-expansion ctx_0) + (root-expand-context/outer-use-site-scopes ctx_0) + (root-expand-context/outer-frame-id ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + (expand-context/outer-name ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0)))) (define effect_2553 (begin @@ -20939,131 +20370,131 @@ (unsafe-immutable-hash-iterate-key s-scs_0 i_0))) - (let ((fold-var_2 - (let ((sym-ht_0 - (let ((table_0 - (scope-binding-table - sc_0))) + (let ((table_0 + (scope-binding-table + sc_0))) + (let ((fold-var_2 + (let ((sym-ht_0 (if (hash? table_0) table_0 (table-with-bulk-bindings-syms - table_0))))) - (begin - #t - (letrec* - ((for-loop_2 - (|#%name| - for-loop - (lambda (fold-var_2 - state_0) - (begin - (if (car - state_0) - (let ((o-sym_0 - (vector-ref - (car - state_0) - 1))) - (let ((scs_0 - (let ((app_1 - (vector-ref - (car - state_0) - 2))) - (hash-iterate-key - app_1 - (cdr - state_0))))) - (let ((b_0 + table_0)))) + (begin + #t + (letrec* + ((for-loop_2 + (|#%name| + for-loop + (lambda (fold-var_2 + state_0) + (begin + (if (car + state_0) + (let ((o-sym_0 + (vector-ref + (car + state_0) + 1))) + (let ((scs_0 (let ((app_1 (vector-ref (car state_0) 2))) - (hash-iterate-value + (hash-iterate-key app_1 (cdr state_0))))) - (let ((scs_1 - scs_0) - (o-sym_1 - o-sym_0)) - (let ((fold-var_3 - (if (eq? - o-sym_1 - sym_0) - fold-var_2 - (let ((fold-var_3 - (cons - (let ((app_1 - (scope-set->context - scs_1))) - (let ((app_2 - (classify-binding_0 - b_0))) - (hasheq - 'name - o-sym_1 - 'context - app_1 - 'match? - #f - app_2 - (extract-binding_0 - b_0)))) - fold-var_2))) - (values - fold-var_3))))) - (for-loop_2 - fold-var_3 - (let ((ht_0 - (vector-ref - (car - state_0) - 2))) - (let ((i_1 - (hash-iterate-next - ht_0 - (cdr - state_0)))) - (if i_1 - (cons - (car - state_0) - i_1) - (next-state-in-full-binding-table - sym-ht_0 - (hash-iterate-next - sym-ht_0 - (vector-ref + (let ((b_0 + (let ((app_1 + (vector-ref + (car + state_0) + 2))) + (hash-iterate-value + app_1 + (cdr + state_0))))) + (let ((scs_1 + scs_0) + (o-sym_1 + o-sym_0)) + (let ((fold-var_3 + (if (eq? + o-sym_1 + sym_0) + fold-var_2 + (let ((fold-var_3 + (cons + (let ((app_1 + (scope-set->context + scs_1))) + (let ((app_2 + (classify-binding_0 + b_0))) + (hasheq + 'name + o-sym_1 + 'context + app_1 + 'match? + #f + app_2 + (extract-binding_0 + b_0)))) + fold-var_2))) + (values + fold-var_3))))) + (for-loop_2 + fold-var_3 + (let ((ht_0 + (vector-ref + (car + state_0) + 2))) + (let ((i_1 + (hash-iterate-next + ht_0 + (cdr + state_0)))) + (if i_1 + (cons (car state_0) - 0)))))))))))) - fold-var_2)))))) - (for-loop_2 - fold-var_1 - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (sym-i_0) - (begin - (if sym-i_0 - (next-state-in-full-binding-table - sym-ht_0 - sym-i_0) - '(#f - . - #f))))))) - (loop_0 - (hash-iterate-first - sym-ht_0))))))))) - (for-loop_1 - fold-var_2 - (unsafe-immutable-hash-iterate-next - s-scs_0 - i_0)))) + i_1) + (next-state-in-full-binding-table + sym-ht_0 + (hash-iterate-next + sym-ht_0 + (vector-ref + (car + state_0) + 0)))))))))))) + fold-var_2)))))) + (for-loop_2 + fold-var_1 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (sym-i_0) + (begin + (if sym-i_0 + (next-state-in-full-binding-table + sym-ht_0 + sym-i_0) + '(#f + . + #f))))))) + (loop_0 + (hash-iterate-first + sym-ht_0))))))))) + (for-loop_1 + fold-var_2 + (unsafe-immutable-hash-iterate-next + s-scs_0 + i_0))))) fold-var_1)))))) (for-loop_1 null @@ -21104,25 +20535,20 @@ (let ((fold-var_1 (cons (if (interned-scope? sc_0) - (let ((app_0 (scope-id sc_0))) - (let ((app_1 (scope-kind sc_0))) - (vector - app_0 - app_1 - (interned-scope-key sc_0)))) + (vector + (scope-id sc_0) + (scope-kind sc_0) + (interned-scope-key sc_0)) (if (representative-scope? sc_0) - (let ((app_0 (scope-id sc_0))) - (let ((app_1 (scope-kind sc_0))) - (vector - app_0 - app_1 - (multi-scope-name - (representative-scope-owner - sc_0))))) - (let ((app_0 (scope-id sc_0))) - (vector - app_0 - (scope-kind sc_0))))) + (vector + (scope-id sc_0) + (scope-kind sc_0) + (multi-scope-name + (representative-scope-owner + sc_0))) + (vector + (scope-id sc_0) + (scope-kind sc_0)))) fold-var_0))) (values fold-var_1)))) (for-loop_0 @@ -21489,38 +20915,39 @@ (string-append (car strs_0) str_0))) (cons app_0 (cdr strs_0))))) (loop_0 app_0 (cdr scopes_1))) - (loop_0 (cons str_0 strs_0) (cdr scopes_1)))))))))) + (let ((app_0 (cons str_0 strs_0))) + (loop_0 app_0 (cdr scopes_1))))))))))) (loop_0 null (if (begin-unsafe (zero? (hash-count common-scopes_0))) scopes_0 - (append - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) - (begin - (if (pair? lst_0) - (let ((s_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (if (not - (begin-unsafe - (hash-ref - common-scopes_0 - s_0 - #f))) - (let ((fold-var_1 - (cons s_0 fold-var_0))) - (values fold-var_1)) - fold-var_0))) - (for-loop_0 fold-var_1 rest_0)))) - fold-var_0)))))) - (for-loop_0 null scopes_0)))) - (list "[common scopes]"))))))) + (let ((app_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((s_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (if (not + (begin-unsafe + (hash-ref + common-scopes_0 + s_0 + #f))) + (let ((fold-var_1 + (cons s_0 fold-var_0))) + (values fold-var_1)) + fold-var_0))) + (for-loop_0 fold-var_1 rest_0)))) + fold-var_0)))))) + (for-loop_0 null scopes_0)))))) + (append app_0 (list "[common scopes]")))))))) (if (null? strs_0) "\n [empty]" (apply @@ -21657,7 +21084,8 @@ (values))))))) (for-loop_0 l_0))) (void) - (hash-set ht_1 (syntax-e$1 v_0) (cons v_0 l_0)))) + (let ((app_0 (syntax-e$1 v_0))) + (hash-set ht_1 app_0 (cons v_0 l_0))))) (if (pair? v_0) (let ((app_0 (cdr v_0))) (loop_0 app_0 (loop_0 (car v_0) ht_1))) @@ -24284,17 +23712,11 @@ (if (eq? base_0 interned-base_0) mpi_0 (if (1/module-path-index? mpi_0) - (let ((app_0 - (module-path-index-path mpi_0))) - (let ((app_1 - (module-path-index-resolved - mpi_0))) - (module-path-index2.1 - app_0 - interned-base_0 - app_1 - (module-path-index-shift-cache - mpi_0)))) + (module-path-index2.1 + (module-path-index-path mpi_0) + interned-base_0 + (module-path-index-resolved mpi_0) + (module-path-index-shift-cache mpi_0)) (raise-argument-error 'struct-copy "module-path-index?" @@ -24766,64 +24188,67 @@ i_0)))))) (for-loop_0 0 0))))) v_0)))))) - (list - 'deserialize-module-path-indexes - (list 'quote gens_0) - (list - 'quote - (call-with-values - (lambda () - (let ((end_0 (hash-count rev-positions_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (vec_0 i_0 pos_0) - (begin - (if (< pos_0 end_0) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((new-vec_0 - (if (eq? - i_0 - (unsafe-vector*-length - vec_0)) - (grow-vector vec_0) - vec_0))) - (begin - (unsafe-vector*-set! - new-vec_0 - i_0 - (hash-ref - gen-order_0 - (hash-ref - rev-positions_0 - pos_0))) - (values - new-vec_0 - (unsafe-fx+ i_0 1))))) - (case-lambda - ((vec_1 i_1) (values vec_1 i_1)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((vec_1 i_1) - (for-loop_0 vec_1 i_1 (+ pos_0 1))) - (args - (raise-binding-result-arity-error - 2 - args)))) - (values vec_0 i_0))))))) - (for-loop_0 (make-vector 16) 0 0))))) - (case-lambda - ((vec_0 i_0) (shrink-vector vec_0 i_0)) - (args - (raise-binding-result-arity-error 2 args))))))))))))))) + (let ((app_0 (list 'quote gens_0))) + (list + 'deserialize-module-path-indexes + app_0 + (list + 'quote + (call-with-values + (lambda () + (let ((end_0 (hash-count rev-positions_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (vec_0 i_0 pos_0) + (begin + (if (< pos_0 end_0) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((new-vec_0 + (if (eq? + i_0 + (unsafe-vector*-length + vec_0)) + (grow-vector vec_0) + vec_0))) + (begin + (unsafe-vector*-set! + new-vec_0 + i_0 + (hash-ref + gen-order_0 + (hash-ref + rev-positions_0 + pos_0))) + (values + new-vec_0 + (unsafe-fx+ i_0 1))))) + (case-lambda + ((vec_1 i_1) (values vec_1 i_1)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((vec_1 i_1) + (for-loop_0 vec_1 i_1 (+ pos_0 1))) + (args + (raise-binding-result-arity-error + 2 + args)))) + (values vec_0 i_0))))))) + (for-loop_0 (make-vector 16) 0 0))))) + (case-lambda + ((vec_0 i_0) (shrink-vector vec_0 i_0)) + (args + (raise-binding-result-arity-error + 2 + args)))))))))))))))) (define deserialize-module-path-indexes (lambda (gen-vec_0 order-vec_0) (let ((gen_0 (make-vector (vector-length gen-vec_0) #f))) @@ -24958,45 +24383,56 @@ vec_0))))) (define generate-module-data-linklet (lambda (mpis_0) - (list - 'linklet - (list deserialize-imports) - (list mpi-vector-id) - (list* 'define-values (list inspector-id) '((current-code-inspector))) - (list - 'define-values - (list mpi-vector-id) - (generate-module-path-index-deserialize mpis_0))))) + (let ((app_0 (list deserialize-imports))) + (let ((app_1 (list mpi-vector-id))) + (let ((app_2 + (list* + 'define-values + (list inspector-id) + '((current-code-inspector))))) + (list + 'linklet + app_0 + app_1 + app_2 + (let ((app_3 (list mpi-vector-id))) + (list + 'define-values + app_3 + (generate-module-path-index-deserialize mpis_0))))))))) (define generate-module-declaration-linklet (lambda (mpis_0 self_0 requires_0 provides_0 phase-to-link-module-uses-expr_0) - (let ((app_0 - (list - 'define-values - '(self-mpi) - (add-module-path-index! mpis_0 self_0)))) + (let ((app_0 (list deserialize-imports (list mpi-vector-id)))) (let ((app_1 (list 'define-values - '(requires) - (generate-deserialize.1 #f requires_0 mpis_0)))) - (list - 'linklet - (list deserialize-imports (list mpi-vector-id)) - '(self-mpi requires provides phase-to-link-modules) - app_0 - app_1 - (list - 'define-values - '(provides) - (generate-deserialize.1 #f provides_0 mpis_0)) - (list - 'define-values - '(phase-to-link-modules) - phase-to-link-module-uses-expr_0)))))) + '(self-mpi) + (add-module-path-index! mpis_0 self_0)))) + (let ((app_2 + (list + 'define-values + '(requires) + (generate-deserialize.1 #f requires_0 mpis_0)))) + (let ((app_3 + (list + 'define-values + '(provides) + (generate-deserialize.1 #f provides_0 mpis_0)))) + (list + 'linklet + app_0 + '(self-mpi requires provides phase-to-link-modules) + app_1 + app_2 + app_3 + (list + 'define-values + '(phase-to-link-modules) + phase-to-link-module-uses-expr_0)))))))) (define serialize-module-uses (lambda (mus_0 mpis_0) (reverse$1 @@ -26557,31 +25993,33 @@ shared-bindings-expr_0 mutable-fills-expr_0 result-expr_0))))))))) - (list - 'let-values - (list + (let ((app_0 + (list + (list + '(data) + (list + 'quote + (vector + mutable-shell-bindings_0 + shared-bindings_0 + mutable-fills_0 + result_0)))))) (list - '(data) - (list - 'quote - (vector - mutable-shell-bindings_0 - shared-bindings_0 - mutable-fills_0 - result_0)))) - (finish_0 - '(unsafe-vector*-ref - data - 0) - '(unsafe-vector*-ref - data - 1) - '(unsafe-vector*-ref - data - 2) - '(unsafe-vector*-ref - data - 3)))))))))))))))))))))))))))))))))) + 'let-values + app_0 + (finish_0 + '(unsafe-vector*-ref + data + 0) + '(unsafe-vector*-ref + data + 1) + '(unsafe-vector*-ref + data + 2) + '(unsafe-vector*-ref + data + 3))))))))))))))))))))))))))))))))))) (define sorted-hash-keys (lambda (ht_0) (let ((ks_0 (hash-keys ht_0))) @@ -26734,7 +26172,7 @@ (lambda (vec_0 pos_0 mpis_0 inspector_0 bulk-binding-registry_0 shared_0) (let ((tmp_0 (unsafe-vector*-ref vec_0 pos_0))) (if (eq? tmp_0 kw2525) - (values (box #f) (add1 pos_0)) + (let ((app_0 (box #f))) (values app_0 (add1 pos_0))) (if (eq? tmp_0 kw2967) (let ((app_0 (make-vector (unsafe-vector*-ref vec_0 (add1 pos_0))))) (values app_0 (+ pos_0 2))) @@ -29108,8 +28546,7 @@ (begin-unsafe (expand-context/inner-declared-submodule-names (root-expand-context/outer-inner ctx_0))))) - (let ((temp7_1 temp7_0)) - (module-path->mpi.1 temp8_0 mod-path_0 temp7_1)))))) + (module-path->mpi.1 temp8_0 mod-path_0 temp7_0))))) (define syntax-mapped-names (lambda (s_0 phase_0) (let ((s-scs_0 (syntax-scope-set s_0 phase_0))) @@ -29349,16 +28786,15 @@ (begin (let ((ht_0 (requires+provides-require-mpis-in-order r+p_0))) (let ((xform_0 (lambda (l_0) (cons mpi_0 l_0)))) - (let ((ht_1 ht_0)) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - ht_1 - phase-shift_0 - xform_0 - null))))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + ht_0 + phase-shift_0 + xform_0 + null)))) (let ((app_0 (hash-ref! (requires+provides-requires r+p_0) @@ -29411,28 +28847,30 @@ id27_0 phase28_0) (begin - (let ((at-mod_0 - (let ((app_0 (requires+provides-requires r+p26_0))) + (let ((app_0 (requires+provides-requires r+p26_0))) + (let ((at-mod_0 (hash-ref! app_0 (begin-unsafe (intern-module-path-index! (requires+provides-require-mpis r+p26_0) nominal-module18_0)) - make-hasheqv)))) - (let ((sym-to-reqds_0 - (hash-ref! at-mod_0 nominal-require-phase19_0 make-hasheq))) - (let ((sym_0 (syntax-e$1 id27_0))) - (hash-set! - sym-to-reqds_0 - sym_0 - (cons-ish - (required2.1 - id27_0 - phase28_0 - can-be-shadowed?20_0 - as-transformer?21_0) - (hash-ref sym-to-reqds_0 sym_0 null)))))))))) + make-hasheqv))) + (let ((sym-to-reqds_0 + (hash-ref! at-mod_0 nominal-require-phase19_0 make-hasheq))) + (let ((sym_0 (syntax-e$1 id27_0))) + (hash-set! + sym-to-reqds_0 + sym_0 + (let ((app_1 + (required2.1 + id27_0 + phase28_0 + can-be-shadowed?20_0 + as-transformer?21_0))) + (cons-ish + app_1 + (hash-ref sym-to-reqds_0 sym_0 null)))))))))))) (define add-bulk-required-ids!.1 (|#%name| add-bulk-required-ids! @@ -29718,14 +29156,12 @@ (let ((temp137_0 (requires+provides-self enclosing-requires+provides54_0))) - (let ((temp136_1 - temp136_0)) - (syntax-module-path-index-shift.1 - #f - temp136_1 - temp137_0 - enclosing-mod57_0 - #f)))) + (syntax-module-path-index-shift.1 + #f + temp136_0 + temp137_0 + enclosing-mod57_0 + #f))) phase-shift58_0))) (let ((temp131_0 (phase+ @@ -30505,16 +29941,15 @@ orig-s100_0 id99_0)))))))) (let ((default_0 hash2610)) - (let ((xform_1 xform_0) (ht_1 ht_0)) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - ht_1 - phase96_0 - xform_1 - default_0))))))))))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + ht_0 + phase96_0 + xform_0 + default_0)))))))))) (define extract-requires-and-provides (lambda (r+p_0 old-self_0 new-self_0) (let ((extract-requires_0 @@ -30660,14 +30095,12 @@ (loop_0 (provided-binding binding_1)))) - (let ((app_1 - (provided-protected? - binding_1))) - (provided1.1 - app_0 - app_1 - (provided-syntax? - binding_1)))) + (provided1.1 + app_0 + (provided-protected? + binding_1) + (provided-syntax? + binding_1))) (binding-module-path-index-shift binding_1 from-mpi_0 @@ -31719,21 +31152,23 @@ spec137_0 id138_0) (let ((app_0 - (if top-req_0 - top-req_0 - req_0))) - (loop_0 - (list - spec137_0) - app_0 - phase-shift_0 - just-meta_0 - (adjust-only1.1 - (ids->sym-set - id138_0)) - #f - #f - 'path))) + (list + spec137_0))) + (let ((app_1 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + app_0 + app_1 + phase-shift_0 + just-meta_0 + (adjust-only1.1 + (ids->sym-set + id138_0)) + #f + #f + 'path)))) (args (raise-binding-result-arity-error 4 @@ -31889,21 +31324,23 @@ id:prefix146_0 spec147_0) (let ((app_0 - (if top-req_0 - top-req_0 - req_0))) - (loop_0 - (list - spec147_0) - app_0 - phase-shift_0 - just-meta_0 - (adjust-prefix2.1 - (syntax-e$1 - id:prefix146_0)) - #f - #f - 'path))) + (list + spec147_0))) + (let ((app_1 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + app_0 + app_1 + phase-shift_0 + just-meta_0 + (adjust-prefix2.1 + (syntax-e$1 + id:prefix146_0)) + #f + #f + 'path)))) (args (raise-binding-result-arity-error 4 @@ -32064,22 +31501,24 @@ spec155_0 id156_0) (let ((app_0 - (if top-req_0 - top-req_0 - req_0))) - (loop_0 - (list - spec155_0) - app_0 - phase-shift_0 - just-meta_0 - (adjust-all-except3.1 - '|| - (ids->sym-set - id156_0)) - #f - #f - 'path))) + (list + spec155_0))) + (let ((app_1 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + app_0 + app_1 + phase-shift_0 + just-meta_0 + (adjust-all-except3.1 + '|| + (ids->sym-set + id156_0)) + #f + #f + 'path)))) (args (raise-binding-result-arity-error 4 @@ -32296,25 +31735,27 @@ spec165_0 id166_0) (let ((app_0 - (if top-req_0 - top-req_0 - req_0))) - (loop_0 - (list - spec165_0) - app_0 - phase-shift_0 - just-meta_0 - (let ((app_1 - (syntax-e$1 - id:prefix164_0))) - (adjust-all-except3.1 - app_1 - (ids->sym-set - id166_0))) - #f - #f - 'path))) + (list + spec165_0))) + (let ((app_1 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + app_0 + app_1 + phase-shift_0 + just-meta_0 + (let ((app_2 + (syntax-e$1 + id:prefix164_0))) + (adjust-all-except3.1 + app_2 + (ids->sym-set + id166_0))) + #f + #f + 'path)))) (args (raise-binding-result-arity-error 5 @@ -32526,22 +31967,24 @@ id:to179_0 id:from180_0) (let ((app_0 - (if top-req_0 - top-req_0 - req_0))) - (loop_0 - (list - spec178_0) - app_0 - phase-shift_0 - just-meta_0 - (adjust-rename4.1 - id:to179_0 - (syntax-e$1 - id:from180_0)) - #f - #f - 'path))) + (list + spec178_0))) + (let ((app_1 + (if top-req_0 + top-req_0 + req_0))) + (loop_0 + app_0 + app_1 + phase-shift_0 + just-meta_0 + (adjust-rename4.1 + id:to179_0 + (syntax-e$1 + id:from180_0)) + #f + #f + 'path)))) (args (raise-binding-result-arity-error 5 @@ -34151,16 +33594,21 @@ (if or-part_0 or-part_0 (let ((c_0 - (let ((app_0 (correlated-linklet-expr l_0))) - (compile-linklet app_0 (correlated-linklet-name l_0))))) + (compile-linklet + (correlated-linklet-expr l_0) + (correlated-linklet-name l_0)))) (begin (set-correlated-linklet-compiled! l_0 c_0) c_0)))) l_0))) (define eval-correlated-linklet (lambda (l_0) (if (correlated-linklet? l_0) (eval-linklet - (let ((app_0 (correlated-linklet-expr l_0))) - (compile-linklet app_0 (correlated-linklet-name l_0) #f #f '()))) + (compile-linklet + (correlated-linklet-expr l_0) + (correlated-linklet-name l_0) + #f + #f + '())) (error 'eval-correlated-linklet "cannot evaluate unknown linklet: ~s" @@ -34610,16 +34058,12 @@ (let ((app_0 (faslable-> (faslable-correlated-e v_0)))) (datum->correlated app_0 - (let ((app_1 (faslable-correlated-source v_0))) - (let ((app_2 (faslable-correlated-line v_0))) - (let ((app_3 (faslable-correlated-column v_0))) - (let ((app_4 (faslable-correlated-position v_0))) - (vector - app_1 - app_2 - app_3 - app_4 - (faslable-correlated-span v_0)))))))))) + (vector + (faslable-correlated-source v_0) + (faslable-correlated-line v_0) + (faslable-correlated-column v_0) + (faslable-correlated-position v_0) + (faslable-correlated-span v_0)))))) (if props_0 (begin (letrec* @@ -35450,8 +34894,9 @@ (call-with-values (lambda () (if (namespace-scopes? original-scopes-s_0) - (let ((app_0 (namespace-scopes-post original-scopes-s_0))) - (values app_0 (namespace-scopes-other original-scopes-s_0))) + (values + (namespace-scopes-post original-scopes-s_0) + (namespace-scopes-other original-scopes-s_0)) (decode-namespace-scopes original-scopes-s_0))) (case-lambda ((old-scs-post_0 old-scs-other_0) @@ -35509,10 +34954,8 @@ (values app_0 (syntax-scope-set (vector-ref vec_0 1) 0)))))) (define namespace-scopes=? (lambda (nss1_0 nss2_0) - (if (let ((app_0 (namespace-scopes-post nss1_0))) - (set=? app_0 (namespace-scopes-post nss2_0))) - (let ((app_0 (namespace-scopes-other nss1_0))) - (set=? app_0 (namespace-scopes-other nss2_0))) + (if (set=? (namespace-scopes-post nss1_0) (namespace-scopes-post nss2_0)) + (set=? (namespace-scopes-other nss1_0) (namespace-scopes-other nss2_0)) #f))) (define struct:syntax-literals (make-record-type-descriptor* 'syntax-literals #f #f #f #f 2 3)) @@ -35956,105 +35399,124 @@ (list* 'make-vector (syntax-literals-count sl6_0) '(#f))))) (list app_0 - (list - 'define-values - (list get-syntax-literal!-id) - (list - 'lambda - '(pos) + (let ((app_1 (list get-syntax-literal!-id))) (list - 'let-values + 'define-values + app_1 (list - (list - '(ready-stx) - (list* 'unsafe-vector*-ref syntax-literals-id '(pos)))) - (list - 'if - 'ready-stx - 'ready-stx - (list* - 'begin - (let ((app_1 - (if skip-deserialize?4_0 - null - (list + 'lambda + '(pos) + (let ((app_2 + (list + (list + '(ready-stx) + (list* + 'unsafe-vector*-ref + syntax-literals-id + '(pos)))))) + (list + 'let-values + app_2 + (list + 'if + 'ready-stx + 'ready-stx + (list* + 'begin + (let ((app_3 + (if skip-deserialize?4_0 + null + (list + (list + 'if + (list* + 'unsafe-vector*-ref + deserialized-syntax-vector-id + '(0)) + '(void) + (list + deserialize-syntax-id + bulk-binding-registry-id)))))) + (qq-append + app_3 + (list + (let ((app_4 + (list + (list + '(stx) + (let ((app_4 + (list + 'syntax-shift-phase-level + (list* + 'unsafe-vector*-ref + deserialized-syntax-vector-id + '(pos)) + phase-shift-id))) + (list + 'syntax-module-path-index-shift + app_4 + (add-module-path-index! mpis7_0 self8_0) + self-id + inspector-id)))))) (list - 'if - (list* - 'unsafe-vector*-ref - deserialized-syntax-vector-id - '(0)) - '(void) - (list - deserialize-syntax-id - bulk-binding-registry-id)))))) - (qq-append - app_1 - (list - (list - 'let-values - (list - (list - '(stx) - (list - 'syntax-module-path-index-shift - (list - 'syntax-shift-phase-level - (list* - 'unsafe-vector*-ref - deserialized-syntax-vector-id - '(pos)) - phase-shift-id) - (add-module-path-index! mpis7_0 self8_0) - self-id - inspector-id))) - (list* - 'letrec-values - (list - (list - '(loop) - (list - 'lambda - '() - (list - 'begin - (list* 'vector-cas! syntax-literals-id '(pos #f stx)) - (list* 'let-values - (list + app_4 + (list* + 'letrec-values (list - '(new-stx) - (list* - 'unsafe-vector*-ref - syntax-literals-id - '(pos)))) - '((if new-stx new-stx (loop)))))))) - '((loop)))))))))))))))))) + (list + '(loop) + (list + 'lambda + '() + (list + 'begin + (list* + 'vector-cas! + syntax-literals-id + '(pos #f stx)) + (list* + 'let-values + (list + (list + '(new-stx) + (list* + 'unsafe-vector*-ref + syntax-literals-id + '(pos)))) + '((if new-stx new-stx (loop)))))))) + '((loop))))))))))))))))))))) (define generate-lazy-syntax-literals-data! (lambda (sl_0 mpis_0) (if (begin-unsafe (null? (syntax-literals-stxes sl_0))) (list (list* 'define-values (list deserialize-syntax-id) '(#f))) (list - (list - 'define-values - (list deserialize-syntax-id) - (list - 'lambda - (list bulk-binding-registry-id) + (let ((app_0 (list deserialize-syntax-id))) (list - 'begin - (list - 'vector-copy! - deserialized-syntax-vector-id - ''0 - (list - 'let-values - (list (list* (list inspector-id) '(#f))) - (let ((temp21_0 - (vector->immutable-vector - (list->vector (reverse$1 (syntax-literals-stxes sl_0)))))) - (generate-deserialize.1 #t temp21_0 mpis_0)))) - (list* 'set! deserialize-syntax-id '(#f))))))))) + 'define-values + app_0 + (let ((app_1 (list bulk-binding-registry-id))) + (list + 'lambda + app_1 + (let ((app_2 + (list + 'vector-copy! + deserialized-syntax-vector-id + ''0 + (let ((app_2 (list (list* (list inspector-id) '(#f))))) + (list + 'let-values + app_2 + (let ((temp21_0 + (vector->immutable-vector + (list->vector + (reverse$1 (syntax-literals-stxes sl_0)))))) + (generate-deserialize.1 #t temp21_0 mpis_0))))))) + (list + 'begin + app_2 + (list* 'set! deserialize-syntax-id '(#f)))))))))))) (define generate-lazy-syntax-literal-lookup (lambda (pos_0) (list get-syntax-literal!-id pos_0))) (define generate-eager-syntax-literals! @@ -36086,14 +35548,16 @@ '(stx) (list 'swap-top-level-scopes - (list - 'syntax-module-path-index-shift - (list - 'syntax-shift-phase-level - 'stx - (list '- base-phase_0 dest-phase-id)) - (add-module-path-index! mpis_0 self_0) - self-id) + (let ((app_1 + (list + 'syntax-shift-phase-level + 'stx + (list '- base-phase_0 dest-phase-id)))) + (list + 'syntax-module-path-index-shift + app_1 + (add-module-path-index! mpis_0 self_0) + self-id)) 'ns-scope-s ns-id)) '((cdr ns+stxss)))))))))) @@ -36212,13 +35676,10 @@ (if or-part_0 or-part_0 (let ((or-part_1 - (let ((app_0 - (module-use-module - mu_0))) - (eq? - app_0 - (compile-context-self - cctx_0))))) + (eq? + (module-use-module mu_0) + (compile-context-self + cctx_0)))) (if or-part_1 or-part_1 (let ((mpi_0 @@ -36228,9 +35689,10 @@ top-level-module-path-index mpi_0))))))) (values ht_0 link-mod-uses_0) - (values - (hash-set ht_0 mu_0 #t) - (cons mu_0 link-mod-uses_0))))) + (let ((app_0 (hash-set ht_0 mu_0 #t))) + (values + app_0 + (cons mu_0 link-mod-uses_0)))))) (case-lambda ((ht_1 link-mod-uses_1) (values ht_1 link-mod-uses_1)) @@ -36329,10 +35791,10 @@ (let ((fold-var_1 (let ((fold-var_1 (cons - (let ((extra-inspectorss_0 - (let ((lst_1 - (header-require-vars-in-order - header_0))) + (let ((lst_1 + (header-require-vars-in-order + header_0))) + (let ((extra-inspectorss_0 (begin (letrec* ((for-loop_1 @@ -36419,11 +35881,11 @@ table_0)))))) (for-loop_1 hash2725 - lst_1)))))) - (if (hash-count - extra-inspectorss_0) - extra-inspectorss_0 - #f)) + lst_1))))) + (if (hash-count + extra-inspectorss_0) + extra-inspectorss_0 + #f))) fold-var_0))) (values fold-var_1)))) (for-loop_0 fold-var_1 rest_0)))) @@ -36676,15 +36138,10 @@ 'lambda (let ((formals_0 (parsed-lambda-keys p3_0))) (let ((bodys_0 (parsed-lambda-body p3_0))) - (let ((formals_1 formals_0)) - (begin-unsafe - (list - formals_1 - (compile-sequence - bodys_0 - cctx4_0 - #f - #t)))))))) + (begin-unsafe + (list + formals_0 + (compile-sequence bodys_0 cctx4_0 #f #t))))))) name1_0 s_0) (let ((s-exp_0 ''unused-lambda)) @@ -36782,52 +36239,52 @@ fold-var_0)))))) (for-loop_0 null rands_0)))))))) (if (parsed-if? p3_0) - (let ((tst-e_0 - (let ((p_0 (parsed-if-tst p3_0))) + (let ((p_0 (parsed-if-tst p3_0))) + (let ((tst-e_0 (begin-unsafe - (begin (compile$2 p_0 cctx4_0 #f #f)))))) - (if (eq? (correlated-e tst-e_0) #t) - (let ((p_0 (parsed-if-thn p3_0))) - (begin-unsafe - (begin - (compile$2 - p_0 - cctx4_0 - name1_0 - result-used?2_0)))) - (if (eq? (correlated-e tst-e_0) #f) - (let ((p_0 (parsed-if-els p3_0))) + (begin (compile$2 p_0 cctx4_0 #f #f))))) + (if (eq? (correlated-e tst-e_0) #t) + (let ((p_1 (parsed-if-thn p3_0))) (begin-unsafe (begin (compile$2 - p_0 + p_1 cctx4_0 name1_0 result-used?2_0)))) - (let ((s-exp_0 - (let ((app_0 - (let ((p_0 - (parsed-if-thn p3_0))) - (begin-unsafe - (begin - (compile$2 - p_0 - cctx4_0 - name1_0 - result-used?2_0)))))) - (list - 'if - tst-e_0 - app_0 - (let ((p_0 (parsed-if-els p3_0))) - (begin-unsafe - (begin - (compile$2 - p_0 - cctx4_0 - name1_0 - result-used?2_0)))))))) - (begin-unsafe s-exp_0))))) + (if (eq? (correlated-e tst-e_0) #f) + (let ((p_1 (parsed-if-els p3_0))) + (begin-unsafe + (begin + (compile$2 + p_1 + cctx4_0 + name1_0 + result-used?2_0)))) + (let ((s-exp_0 + (let ((app_0 + (let ((p_1 + (parsed-if-thn p3_0))) + (begin-unsafe + (begin + (compile$2 + p_1 + cctx4_0 + name1_0 + result-used?2_0)))))) + (list + 'if + tst-e_0 + app_0 + (let ((p_1 (parsed-if-els p3_0))) + (begin-unsafe + (begin + (compile$2 + p_1 + cctx4_0 + name1_0 + result-used?2_0)))))))) + (begin-unsafe s-exp_0)))))) (if (parsed-with-continuation-mark? p3_0) (let ((s-exp_0 (let ((app_0 @@ -36930,9 +36387,8 @@ result-used?2_0))) (begin-unsafe s-exp_0)) (if (parsed-set!? p3_0) - (let ((s-exp_0 - (let ((temp21_0 - (parsed-set!-id p3_0))) + (let ((temp21_0 (parsed-set!-id p3_0))) + (let ((s-exp_0 (let ((temp24_0 (let ((p_0 (parsed-set!-rhs @@ -36941,21 +36397,20 @@ (parsed-s (parsed-set!-id p3_0)))) - (let ((p_1 p_0)) - (begin-unsafe - (begin - (compile$2 - p_1 - cctx4_0 - name_0 - #t)))))))) + (begin-unsafe + (begin + (compile$2 + p_0 + cctx4_0 + name_0 + #t))))))) (let ((temp21_1 temp21_0)) (compile-identifier.1 temp24_0 #t temp21_1 - cctx4_0)))))) - (begin-unsafe s-exp_0)) + cctx4_0))))) + (begin-unsafe s-exp_0))) (if (parsed-let-values? p3_0) (compile-let.1 #f @@ -37108,104 +36563,103 @@ (reverse$1 (let ((lst_0 (parsed-let_-values-clauses p7_0))) (let ((lst_1 (parsed-let_-values-idss p7_0))) - (let ((lst_2 lst_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_3 lst_4) - (begin - (if (if (pair? lst_3) - (pair? lst_4) - #f) - (let ((clause_0 - (unsafe-car lst_3))) - (let ((rest_0 - (unsafe-cdr lst_3))) - (let ((ids_0 - (unsafe-car lst_4))) - (let ((rest_1 - (unsafe-cdr lst_4))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_1 - (if rec?5_0 - (reverse$1 - (let ((lst_5 - (car - clause_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_1 - lst_6 - lst_7) - (begin - (if (if (pair? - lst_6) - (pair? - lst_7) - #f) - (let ((sym_0 - (unsafe-car - lst_6))) - (let ((rest_2 - (unsafe-cdr + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_2 lst_3) + (begin + (if (if (pair? lst_2) + (pair? lst_3) + #f) + (let ((clause_0 + (unsafe-car lst_2))) + (let ((rest_0 + (unsafe-cdr lst_2))) + (let ((ids_0 + (unsafe-car lst_3))) + (let ((rest_1 + (unsafe-cdr lst_3))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (let ((app_1 + (if rec?5_0 + (reverse$1 + (let ((lst_4 + (car + clause_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_1 + lst_5 + lst_6) + (begin + (if (if (pair? + lst_5) + (pair? + lst_6) + #f) + (let ((sym_0 + (unsafe-car + lst_5))) + (let ((rest_2 + (unsafe-cdr + lst_5))) + (let ((id_0 + (unsafe-car lst_6))) - (let ((id_0 - (unsafe-car - lst_7))) - (let ((rest_3 - (unsafe-cdr - lst_7))) - (let ((fold-var_2 - (let ((fold-var_2 - (cons - (add-undefined-error-name-property - sym_0 - id_0) - fold-var_1))) - (values - fold-var_2)))) - (for-loop_1 - fold-var_2 - rest_2 - rest_3)))))) - fold-var_1)))))) - (for-loop_1 - null - lst_5 - ids_0))))) - (car - clause_0)))) - (list - app_1 - (let ((app_2 - (cadr - clause_0))) - (compile$2 - app_2 - cctx8_0 - (if (= - 1 - (length - ids_0)) - (car - ids_0) - #f))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1)))))) - fold-var_0)))))) - (for-loop_0 null lst_2 lst_1))))))))) + (let ((rest_3 + (unsafe-cdr + lst_6))) + (let ((fold-var_2 + (let ((fold-var_2 + (cons + (add-undefined-error-name-property + sym_0 + id_0) + fold-var_1))) + (values + fold-var_2)))) + (for-loop_1 + fold-var_2 + rest_2 + rest_3)))))) + fold-var_1)))))) + (for-loop_1 + null + lst_4 + ids_0))))) + (car + clause_0)))) + (list + app_1 + (let ((app_2 + (cadr + clause_0))) + (compile$2 + app_2 + cctx8_0 + (if (= + 1 + (length + ids_0)) + (car + ids_0) + #f))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1)))))) + fold-var_0)))))) + (for-loop_0 null lst_0 lst_1)))))))) (list app_0 app_1 @@ -37513,18 +36967,15 @@ (let ((extra-inspectorss_0 (unsafe-car lst_1))) (let ((rest_1 (unsafe-cdr lst_1))) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_0 - (module-use-module mu_0))) - (module-use*1.1 - app_0 - (module-use-phase mu_0) - extra-inspectorss_0 - #f)) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0 rest_1)))))) + (cons + (module-use*1.1 + (module-use-module mu_0) + (module-use-phase mu_0) + extra-inspectorss_0 + #f) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0 rest_1))))))) fold-var_0)))))) (for-loop_0 null mus_0 extra-inspectorsss_0)))) (reverse$1 @@ -37539,17 +36990,15 @@ (let ((mu_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_0 (module-use-module mu_0))) - (module-use*1.1 - app_0 - (module-use-phase mu_0) - #f - #f)) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) + (cons + (module-use*1.1 + (module-use-module mu_0) + (module-use-phase mu_0) + #f + #f) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null mus_0))))))) (define module-uses-strip-extra-inspectorsss @@ -37566,15 +37015,13 @@ (let ((mu*_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_0 (module-use-module mu*_0))) - (module-use1.1 - app_0 - (module-use-phase mu*_0))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) + (cons + (module-use1.1 + (module-use-module mu*_0) + (module-use-phase mu*_0)) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null mu*s_0)))))) (define module-uses-extract-extra-inspectorsss @@ -37592,12 +37039,11 @@ (let ((mu*_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (module-use*-extra-inspectorss mu*_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) + (cons + (module-use*-extra-inspectorss mu*_0) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null mu*s_0)))) (reverse$1 @@ -38239,34 +37685,26 @@ (for-loop_1 null binding-syms_0))))))) - (let ((rhs_0 - (let ((app_0 - (parsed-define-values-rhs - body_0))) + (let ((app_0 + (parsed-define-values-rhs + body_0))) + (let ((rhs_0 (let ((app_1 (if (compile-context? cctx33_0) - (let ((app_1 - (compile-context-namespace - cctx33_0))) - (let ((app_2 - (compile-context-self - cctx33_0))) - (let ((app_3 - (compile-context-module-self - cctx33_0))) - (let ((app_4 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_1 - phase_1 - app_2 - app_3 - app_4 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) + (compile-context1.1 + (compile-context-namespace + cctx33_0) + phase_1 + (compile-context-self + cctx33_0) + (compile-context-module-self + cctx33_0) + (compile-context-full-module-name + cctx33_0) + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0) (raise-argument-error 'struct-copy "compile-context?" @@ -38280,118 +37718,110 @@ 1) (car ids_0) - #f)))))) - (begin - (|#%app| - definition-callback9_0) - (let ((app_0 - (length - def-syms_0))) + #f))))) + (begin (|#%app| - compiled-expression-callback8_0 - rhs_0 - app_0 + definition-callback9_0) + (let ((app_1 + (length + def-syms_0))) + (|#%app| + compiled-expression-callback8_0 + rhs_0 + app_1 + phase_1 + (as-required?_0 + header_0))) + (add-body!_0 phase_1 - (as-required?_0 - header_0))) - (add-body!_0 - phase_1 - (let ((app_0 - (correlate* - (parsed-s - body_0) - (list - 'define-values - def-syms_0 - rhs_0)))) - (propagate-inline-property - app_0 - (parsed-s - body_0)))) - (if (let ((or-part_0 - (compile-context-module-self - cctx33_0))) - (if or-part_0 - or-part_0 - (null? - ids_0))) - (void) - (begin - (add-body!_0 - phase_1 - (list* - 'if - #f - (list* - 'begin - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1) - (begin - (if (pair? - lst_1) - (let ((def-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr + (let ((app_1 + (correlate* + (parsed-s + body_0) + (list + 'define-values + def-syms_0 + rhs_0)))) + (propagate-inline-property + app_1 + (parsed-s + body_0)))) + (if (let ((or-part_0 + (compile-context-module-self + cctx33_0))) + (if or-part_0 + or-part_0 + (null? + ids_0))) + (void) + (begin + (add-body!_0 + phase_1 + (list* + 'if + #f + (list* + 'begin + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1) + (begin + (if (pair? + lst_1) + (let ((def-sym_0 + (unsafe-car lst_1))) - (let ((fold-var_1 - (cons - (list* - 'set! - def-sym_0 - '(#f)) - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_1 - fold-var_2 - rest_1))))) - fold-var_0)))))) - (for-loop_1 - null - def-syms_0))))) - '((void)))) - (add-body!_0 - phase_1 - (compile-top-level-bind - ids_0 - binding-syms_0 - (if (compile-context? - cctx33_0) - (let ((app_0 - (compile-context-namespace - cctx33_0))) - (let ((app_1 - (compile-context-self - cctx33_0))) - (let ((app_2 - (compile-context-module-self - cctx33_0))) - (let ((app_3 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_0 - phase_1 - app_1 - app_2 - app_3 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)) - #f))))))))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (cons + (list* + 'set! + def-sym_0 + '(#f)) + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_1 + fold-var_2 + rest_1))))) + fold-var_0)))))) + (for-loop_1 + null + def-syms_0))))) + '((void)))) + (add-body!_0 + phase_1 + (compile-top-level-bind + ids_0 + binding-syms_0 + (if (compile-context? + cctx33_0) + (compile-context1.1 + (compile-context-namespace + cctx33_0) + phase_1 + (compile-context-self + cctx33_0) + (compile-context-module-self + cctx33_0) + (compile-context-full-module-name + cctx33_0) + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)) + #f)))))))))) (if (parsed-define-syntaxes? body_0) (let ((ids_0 @@ -38447,10 +37877,10 @@ (for-loop_1 null binding-syms_0)))))) - (let ((rhs_0 - (let ((app_0 - (parsed-define-syntaxes-rhs - body_0))) + (let ((app_0 + (parsed-define-syntaxes-rhs + body_0))) + (let ((rhs_0 (compile$2 app_0 (if (compile-context? @@ -38458,158 +37888,144 @@ (let ((phase71_0 (add1 phase_1))) - (let ((app_1 - (compile-context-namespace - cctx33_0))) - (let ((app_2 - (compile-context-self - cctx33_0))) - (let ((app_3 - (compile-context-module-self - cctx33_0))) - (let ((app_4 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_1 - phase71_0 - app_2 - app_3 - app_4 - (compile-context-lazy-syntax-literals? - cctx33_0) - next-header_0)))))) + (compile-context1.1 + (compile-context-namespace + cctx33_0) + phase71_0 + (compile-context-self + cctx33_0) + (compile-context-module-self + cctx33_0) + (compile-context-full-module-name + cctx33_0) + (compile-context-lazy-syntax-literals? + cctx33_0) + next-header_0)) (raise-argument-error 'struct-copy "compile-context?" - cctx33_0)))))) - (begin - (|#%app| - definition-callback9_0) + cctx33_0))))) (begin - (let ((app_0 - (length - gen-syms_0))) + (|#%app| + definition-callback9_0) + (begin (let ((app_1 - (add1 - phase_1))) - (|#%app| - compiled-expression-callback8_0 - rhs_0 - app_0 - app_1 - (as-required?_0 - header_0)))) - (let ((transformer-set!s_0 - (reverse$1 - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_1 - lst_2) - (begin - (if (if (pair? - lst_1) - (pair? + (length + gen-syms_0))) + (let ((app_2 + (add1 + phase_1))) + (|#%app| + compiled-expression-callback8_0 + rhs_0 + app_1 + app_2 + (as-required?_0 + header_0)))) + (let ((transformer-set!s_0 + (reverse$1 + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_1 lst_2) - #f) - (let ((binding-sym_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr + (begin + (if (if (pair? + lst_1) + (pair? + lst_2) + #f) + (let ((binding-sym_0 + (unsafe-car lst_1))) - (let ((gen-sym_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((gen-sym_0 + (unsafe-car lst_2))) - (let ((fold-var_1 - (cons - (list - set-transformer!-id - (list - 'quote - binding-sym_0) - gen-sym_0) - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_1 - fold-var_2 - rest_1 - rest_2))))))) - fold-var_0)))))) - (for-loop_1 - null - binding-syms_0 - gen-syms_0)))))) - (begin - (if (compile-context-module-self - cctx33_0) - (let ((app_0 - (add1 - phase_1))) - (add-body!_0 - app_0 - (list - 'let-values - (list - (list + (let ((rest_2 + (unsafe-cdr + lst_2))) + (let ((fold-var_1 + (cons + (list + set-transformer!-id + (list + 'quote + binding-sym_0) + gen-sym_0) + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_1 + fold-var_2 + rest_1 + rest_2))))))) + fold-var_0)))))) + (for-loop_1 + null + binding-syms_0 + gen-syms_0)))))) + (begin + (if (compile-context-module-self + cctx33_0) + (let ((app_1 + (add1 + phase_1))) + (add-body!_0 + app_1 + (let ((app_2 + (list + (list + gen-syms_0 + rhs_0)))) + (list + 'let-values + app_2 + (list* + 'begin + (qq-append + transformer-set!s_0 + '((void)))))))) + (let ((app_1 + (add1 + phase_1))) + (add-body!_0 + app_1 + (generate-top-level-define-syntaxes gen-syms_0 - rhs_0)) - (list* - 'begin - (qq-append + rhs_0 transformer-set!s_0 - '((void))))))) - (let ((app_0 - (add1 - phase_1))) - (add-body!_0 - app_0 - (generate-top-level-define-syntaxes - gen-syms_0 - rhs_0 - transformer-set!s_0 - (compile-top-level-bind - ids_0 - binding-syms_0 - (if (compile-context? - cctx33_0) - (let ((app_1 - (compile-context-namespace - cctx33_0))) - (let ((app_2 - (compile-context-self - cctx33_0))) - (let ((app_3 - (compile-context-module-self - cctx33_0))) - (let ((app_4 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_1 - phase_1 - app_2 - app_3 - app_4 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) - (raise-argument-error - 'struct-copy - "compile-context?" - cctx33_0)) - gen-syms_0))))) - (set! saw-define-syntaxes?_0 - #t)))))))))) + (compile-top-level-bind + ids_0 + binding-syms_0 + (if (compile-context? + cctx33_0) + (compile-context1.1 + (compile-context-namespace + cctx33_0) + phase_1 + (compile-context-self + cctx33_0) + (compile-context-module-self + cctx33_0) + (compile-context-full-module-name + cctx33_0) + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0) + (raise-argument-error + 'struct-copy + "compile-context?" + cctx33_0)) + gen-syms_0))))) + (set! saw-define-syntaxes?_0 + #t))))))))))) (if (parsed-begin-for-syntax? body_0) (let ((app_0 @@ -38642,27 +38058,19 @@ body_0 (if (compile-context? cctx33_0) - (let ((app_0 - (compile-context-namespace - cctx33_0))) - (let ((app_1 - (compile-context-self - cctx33_0))) - (let ((app_2 - (compile-context-module-self - cctx33_0))) - (let ((app_3 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_0 - phase_1 - app_1 - app_2 - app_3 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) + (compile-context1.1 + (compile-context-namespace + cctx33_0) + phase_1 + (compile-context-self + cctx33_0) + (compile-context-module-self + cctx33_0) + (compile-context-full-module-name + cctx33_0) + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0) (raise-argument-error 'struct-copy "compile-context?" @@ -38684,27 +38092,19 @@ (let ((app_0 (if (compile-context? cctx33_0) - (let ((app_0 - (compile-context-namespace - cctx33_0))) - (let ((app_1 - (compile-context-self - cctx33_0))) - (let ((app_2 - (compile-context-module-self - cctx33_0))) - (let ((app_3 - (compile-context-full-module-name - cctx33_0))) - (compile-context1.1 - app_0 - phase_1 - app_1 - app_2 - app_3 - (compile-context-lazy-syntax-literals? - cctx33_0) - header_0))))) + (compile-context1.1 + (compile-context-namespace + cctx33_0) + phase_1 + (compile-context-self + cctx33_0) + (compile-context-module-self + cctx33_0) + (compile-context-full-module-name + cctx33_0) + (compile-context-lazy-syntax-literals? + cctx33_0) + header_0) (raise-argument-error 'struct-copy "compile-context?" @@ -38874,13 +38274,11 @@ phase-to-header_0 phase_1)))) (let ((module-use*s_0 - (let ((app_0 - (link-info-link-module-uses - li_0))) - (module-uses-add-extra-inspectorsss - app_0 - (link-info-extra-inspectorsss - li_0))))) + (module-uses-add-extra-inspectorsss + (link-info-link-module-uses + li_0) + (link-info-extra-inspectorsss + li_0)))) (let ((body-linklet_0 (let ((app_0 (qq-append @@ -39282,20 +38680,22 @@ id_0 top-level-bind-scope_0) cctx_0))) - (list - top-level-bind!-id - id-stx_0 - self-expr_0 - phase_0 - phase-shift-id - ns-id - (list - 'quote - binding-sym_0) - (if trans-exprs_0 - #t - #f) - trans-expr_0)) + (let ((app_0 + (list + 'quote + binding-sym_0))) + (list + top-level-bind!-id + id-stx_0 + self-expr_0 + phase_0 + phase-shift-id + ns-id + app_0 + (if trans-exprs_0 + #t + #f) + trans-expr_0))) fold-var_0))) (values fold-var_1)))) (for-loop_0 @@ -39311,60 +38711,66 @@ lst_0)))))))))))))) (define generate-top-level-define-syntaxes (lambda (gen-syms_0 rhs_0 transformer-set!s_0 finish_0) - (list - 'call-with-values - (list 'lambda '() rhs_0) - (list* - 'case-lambda - (let ((app_0 - (if (null? gen-syms_0) - '() - (list - (list - gen-syms_0 - (list* - 'begin - (qq-append - transformer-set!s_0 - (qq-append (cdr finish_0) '((void)))))))))) - (qq-append - app_0 - (list - (list - '() - (let ((app_1 + (let ((app_0 (list 'lambda '() rhs_0))) + (list + 'call-with-values + app_0 + (list* + 'case-lambda + (let ((app_1 + (if (null? gen-syms_0) + '() + (list (list - (list - gen-syms_0 - (list* - 'values - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 lst_0) + gen-syms_0 + (list* + 'begin + (qq-append + transformer-set!s_0 + (qq-append (cdr finish_0) '((void)))))))))) + (qq-append + app_1 + (let ((app_2 + (list + '() + (let ((app_2 + (list + (list + gen-syms_0 + (list* + 'values + (reverse$1 (begin - (if (pair? lst_0) - (let ((s_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (cons ''#f fold-var_0))) - (let ((fold-var_2 (values fold-var_1))) - (for-loop_0 fold-var_2 rest_0))))) - fold-var_0)))))) - (for-loop_0 null gen-syms_0))))))))) + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 lst_0) + (begin + (if (pair? lst_0) + (let ((s_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (let ((fold-var_1 + (cons ''#f fold-var_0))) + (let ((fold-var_2 + (values fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0))))) + fold-var_0)))))) + (for-loop_0 null gen-syms_0))))))))) + (list + 'let-values + app_2 + (list* 'begin (qq-append (cdr finish_0) '((void))))))))) (list - 'let-values - app_1 - (list* 'begin (qq-append (cdr finish_0) '((void))))))) - (list - 'args - (list* - 'let-values - (list (list* gen-syms_0 '((apply values args)))) - '((void))))))))))) + app_2 + (list + 'args + (list* + 'let-values + (list (list* gen-syms_0 '((apply values args)))) + '((void))))))))))))) (define propagate-inline-property (lambda (e_0 orig-s_0) (let ((v_0 @@ -39529,98 +38935,93 @@ (let ((extra-inspectorsss_0 (module-linklet-info-extra-inspectorsss mli_0))) - (let ((mus_1 mus_0)) - (reverse$1 - (let ((lst_0 - (linklet-import-variables - (module-linklet-info-linklet-or-instance - mli_0)))) - (let ((lst_1 - (if extra-inspectorsss_0 - extra-inspectorsss_0 - mus_1))) - (let ((lst_2 lst_0)) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_3 - lst_4 - lst_5) - (begin - (if (if (pair? lst_3) - (if (pair? lst_4) - (pair? lst_5) - #f) + (reverse$1 + (let ((lst_0 + (linklet-import-variables + (module-linklet-info-linklet-or-instance + mli_0)))) + (let ((lst_1 + (if extra-inspectorsss_0 + extra-inspectorsss_0 + mus_0))) + (let ((lst_2 lst_0)) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_3 + lst_4 + lst_5) + (begin + (if (if (pair? lst_3) + (if (pair? lst_4) + (pair? lst_5) #f) - (let ((sub-mu_0 - (unsafe-car + #f) + (let ((sub-mu_0 + (unsafe-car + lst_3))) + (let ((rest_0 + (unsafe-cdr lst_3))) - (let ((rest_0 - (unsafe-cdr - lst_3))) - (let ((imports_0 - (unsafe-car + (let ((imports_0 + (unsafe-car + lst_4))) + (let ((rest_1 + (unsafe-cdr lst_4))) - (let ((rest_1 - (unsafe-cdr - lst_4))) - (let ((extra-inspectorss_0 - (unsafe-car + (let ((extra-inspectorss_0 + (unsafe-car + lst_5))) + (let ((rest_2 + (unsafe-cdr lst_5))) - (let ((rest_2 - (unsafe-cdr - lst_5))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (intern-module-use*_0 - (let ((app_1 - (let ((app_1 - (module-use-module - sub-mu_0))) - (let ((app_2 - (module-linklet-info-self - mli_0))) - (module-path-index-shift - app_1 - app_2 - (module-use-module - mu*-or-instance_0)))))) - (let ((app_2 - (module-use-phase - sub-mu_0))) - (let ((app_3 - (module-linklet-info-inspector + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (intern-module-use*_0 + (let ((app_1 + (module-path-index-shift + (module-use-module + sub-mu_0) + (module-linklet-info-self + mli_0) + (module-use-module + mu*-or-instance_0)))) + (let ((app_2 + (module-use-phase + sub-mu_0))) + (let ((app_3 + (module-linklet-info-inspector + mli_0))) + (let ((app_4 + (module-linklet-info-extra-inspector mli_0))) - (let ((app_4 - (module-linklet-info-extra-inspector - mli_0))) - (module-use+extra-inspectors - app_1 - app_2 - imports_0 - app_3 - app_4 - (if extra-inspectorsss_0 - extra-inspectorss_0 - #f))))))) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0 - rest_1 - rest_2)))))))) - fold-var_0)))))) - (for-loop_0 - null - mus_1 - lst_2 - lst_1)))))))))))) + (module-use+extra-inspectors + app_1 + app_2 + imports_0 + app_3 + app_4 + (if extra-inspectorsss_0 + extra-inspectorss_0 + #f))))))) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0 + rest_1 + rest_2)))))))) + fold-var_0)))))) + (for-loop_0 + null + mus_0 + lst_2 + lst_1))))))))))) #f))) (values #f #f))))) (values #f #f)))))))))) @@ -39759,50 +39160,59 @@ rest_0)))) fold-var_0)))))) (for-loop_0 null lst_0)))))))) - (let ((linklet-s_0 + (let ((app_0 (list - 'linklet - (list - deserialize-imports - eager-instance-imports) - (list* - mpi-vector-id - '(mpi-vector-trees - phase-to-link-modules-vector - phase-to-link-modules-trees - syntax-literals - syntax-literals-trees)) - (list - 'define-values - (list mpi-vector-id) - (generate-module-path-index-deserialize - mpis_0)) - (list - 'define-values - '(mpi-vector-trees) - (list 'quote mpi-trees_0)) - (list - 'define-values - '(phase-to-link-modules-vector) - phase-to-link-module-uses-expr_0) - (list - 'define-values - '(phase-to-link-modules-trees) - (list - 'quote - phase-to-link-module-uses-trees_0)) - (list - 'define-values - '(syntax-literals) - syntax-literals-expr_0) - (list - 'define-values - '(syntax-literals-trees) - (list 'quote syntax-literals-trees_0))))) - (if to-correlated-linklet?1_0 - (begin-unsafe - (correlated-linklet1.1 linklet-s_0 #f #f)) - (compile-linklet linklet-s_0)))))))))))))))) + deserialize-imports + eager-instance-imports))) + (let ((linklet-s_0 + (let ((app_1 + (list* + mpi-vector-id + '(mpi-vector-trees + phase-to-link-modules-vector + phase-to-link-modules-trees + syntax-literals + syntax-literals-trees)))) + (let ((app_2 + (let ((app_2 (list mpi-vector-id))) + (list + 'define-values + app_2 + (generate-module-path-index-deserialize + mpis_0))))) + (list + 'linklet + app_0 + app_1 + app_2 + (list + 'define-values + '(mpi-vector-trees) + (list 'quote mpi-trees_0)) + (list + 'define-values + '(phase-to-link-modules-vector) + phase-to-link-module-uses-expr_0) + (list + 'define-values + '(phase-to-link-modules-trees) + (list + 'quote + phase-to-link-module-uses-trees_0)) + (list + 'define-values + '(syntax-literals) + syntax-literals-expr_0) + (list + 'define-values + '(syntax-literals-trees) + (list + 'quote + syntax-literals-trees_0))))))) + (if to-correlated-linklet?1_0 + (begin-unsafe + (correlated-linklet1.1 linklet-s_0 #f #f)) + (compile-linklet linklet-s_0))))))))))))))))) (define map-cim-tree (lambda (cims_0 proc_0) (letrec* @@ -42765,13 +42175,15 @@ lst_6))) (let ((locals_3 (let ((locals_3 - (hash-set - locals_2 - (correlated-e - id_0) - (known-struct-op9.1 - type_0 - field-count_0)))) + (let ((app_0 + (correlated-e + id_0))) + (hash-set + locals_2 + app_0 + (known-struct-op9.1 + type_0 + field-count_0))))) (values locals_3)))) (for-loop_1 @@ -43599,92 +43011,102 @@ 'serialize) (void)) (begin0 - (let ((app_0 - (compile-context-self - cctx8_0))) - (generate-eager-syntax-literals! - syntax-literals_0 - mpis_0 - phase_0 - app_0 - (compile-context-namespace - cctx8_0))) + (generate-eager-syntax-literals! + syntax-literals_0 + mpis_0 + phase_0 + (compile-context-self cctx8_0) + (compile-context-namespace + cctx8_0)) (if log-performance? (end-performance-region) (void)))))) - (let ((link-linklet_0 - (let ((s_0 - (let ((app_0 - (list - 'define-values - (list mpi-vector-id) - (generate-module-path-index-deserialize - mpis_0)))) - (list - 'linklet - (list - deserialize-imports - eager-instance-imports) - (list - mpi-vector-id - deserialized-syntax-vector-id - 'phase-to-link-modules - syntax-literals-id) - app_0 - (list - 'define-values - (list - deserialized-syntax-vector-id) - (list* - 'make-vector - (add1 phase_0) - '(#f))) - (list - 'define-values - '(phase-to-link-modules) - phase-to-link-module-uses-expr_0) - (list - 'define-values - (list syntax-literals-id) - syntax-literals-expr_0))))) - (if to-correlated-linklet?3_0 - (begin-unsafe - (correlated-linklet1.1 - s_0 - #f - #f)) - (begin - (if log-performance? - (start-performance-region - 'compile - 'top - 'linklet) - (void)) - (begin0 - (call-with-values - (lambda () - (compile-linklet - s_0 - #f - (vector - deserialize-instance - empty-eager-instance-instance) - (lambda (inst_0) - (values inst_0 #f)))) - (case-lambda - ((linklet_0 new-keys_0) - linklet_0) - (args - (raise-binding-result-arity-error - 2 - args)))) + (let ((app_0 + (list + deserialize-imports + eager-instance-imports))) + (let ((link-linklet_0 + (let ((s_0 + (let ((app_1 + (list + mpi-vector-id + deserialized-syntax-vector-id + 'phase-to-link-modules + syntax-literals-id))) + (let ((app_2 + (let ((app_2 + (list + mpi-vector-id))) + (list + 'define-values + app_2 + (generate-module-path-index-deserialize + mpis_0))))) + (let ((app_3 + (let ((app_3 + (list + deserialized-syntax-vector-id))) + (list + 'define-values + app_3 + (list* + 'make-vector + (add1 + phase_0) + '(#f)))))) + (list + 'linklet + app_0 + app_1 + app_2 + app_3 + (list + 'define-values + '(phase-to-link-modules) + phase-to-link-module-uses-expr_0) + (list + 'define-values + (list + syntax-literals-id) + syntax-literals-expr_0))))))) + (if to-correlated-linklet?3_0 + (begin-unsafe + (correlated-linklet1.1 + s_0 + #f + #f)) + (begin (if log-performance? - (end-performance-region) - (void)))))))) - (hash-set - body-linklets_0 - 'link - link-linklet_0))) + (start-performance-region + 'compile + 'top + 'linklet) + (void)) + (begin0 + (call-with-values + (lambda () + (compile-linklet + s_0 + #f + (vector + deserialize-instance + empty-eager-instance-instance) + (lambda (inst_0) + (values inst_0 #f)))) + (case-lambda + ((linklet_0 new-keys_0) + linklet_0) + (args + (raise-binding-result-arity-error + 2 + args)))) + (if log-performance? + (end-performance-region) + (void)))))))) + (hash-set + body-linklets_0 + 'link + link-linklet_0)))) body-linklets_0))))) (let ((app_0 (hash->linklet-directory (hasheq #f bundle_0)))) @@ -43903,22 +43325,17 @@ (begin-unsafe (root-expand-context/inner-top-level-bind-scope (root-expand-context/outer-inner ctx_0))))) - (let ((temp40_1 temp40_0) - (temp39_1 temp39_0) - (temp38_1 temp38_0) - (temp37_1 temp37_0) - (temp36_1 temp36_0)) - (select-defined-syms-and-bind!.1 - #f - temp40_1 - #f - #f - temp41_0 - tl-ids_0 - temp36_1 - temp37_1 - temp38_1 - temp39_1)))))))))) + (select-defined-syms-and-bind!.1 + #f + temp40_0 + #f + #f + temp41_0 + tl-ids_0 + temp36_0 + temp37_0 + temp38_0 + temp39_0))))))))) (define add-defined-sym! (lambda (defined-syms_0 phase_0 sym_0 id_0) (let ((defined-syms-at-phase_0 @@ -43931,161 +43348,162 @@ (define make-create-root-expand-context-from-module (lambda (requires_0 evaled-ld-h_0) (lambda (ns_0 phase-shift_0 original-self_0 self_0) - (let ((root-ctx_0 - (let ((temp1_0 (namespace-mpi ns_0))) + (let ((temp1_0 (namespace-mpi ns_0))) + (let ((root-ctx_0 (make-root-expand-context.1 #f null unsafe-undefined unsafe-undefined - temp1_0)))) - (let ((s_0 - (add-scopes - empty-syntax - (begin-unsafe - (root-expand-context/inner-module-scopes - (root-expand-context/outer-inner root-ctx_0)))))) - (begin + temp1_0))) + (let ((s_0 + (add-scopes + empty-syntax + (begin-unsafe + (root-expand-context/inner-module-scopes + (root-expand-context/outer-inner root-ctx_0)))))) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? lst_0) - (let ((phase+reqs_0 (unsafe-car lst_0))) - (let ((rest_0 (unsafe-cdr lst_0))) - (begin - (let ((phase_0 (car phase+reqs_0))) - (begin - (let ((lst_1 (cdr phase+reqs_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_2) - (begin - (if (pair? lst_2) - (let ((req_0 - (unsafe-car lst_2))) - (let ((rest_1 - (unsafe-cdr lst_2))) - (begin - (let ((mpi_0 - (module-path-index-shift - req_0 - original-self_0 - self_0))) - (let ((temp7_0 - (phase+ - phase_0 - phase-shift_0))) - (perform-require!.1 - #f - #t - #f - #f - #f - #f - 'all - temp7_0 - #f - phase-shift_0 - #f - #f - #t - 'module - mpi_0 - s_0 - self_0 - s_0 - ns_0))) - (for-loop_1 rest_1)))) - (values))))))) - (for-loop_1 lst_1)))) - (void))) - (for-loop_0 rest_0)))) - (values))))))) - (for-loop_0 requires_0))) - (let ((defined-syms_0 - (begin-unsafe - (root-expand-context/inner-defined-syms - (root-expand-context/outer-inner root-ctx_0))))) (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? lst_0) + (let ((phase+reqs_0 (unsafe-car lst_0))) + (let ((rest_0 (unsafe-cdr lst_0))) + (begin + (let ((phase_0 (car phase+reqs_0))) + (begin + (let ((lst_1 (cdr phase+reqs_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_2) + (begin + (if (pair? lst_2) + (let ((req_0 + (unsafe-car lst_2))) + (let ((rest_1 + (unsafe-cdr lst_2))) + (begin + (let ((mpi_0 + (module-path-index-shift + req_0 + original-self_0 + self_0))) + (let ((temp7_0 + (phase+ + phase_0 + phase-shift_0))) + (perform-require!.1 + #f + #t + #f + #f + #f + #f + 'all + temp7_0 + #f + phase-shift_0 + #f + #f + #t + 'module + mpi_0 + s_0 + self_0 + s_0 + ns_0))) + (for-loop_1 rest_1)))) + (values))))))) + (for-loop_1 lst_1)))) + (void))) + (for-loop_0 rest_0)))) + (values))))))) + (for-loop_0 requires_0))) + (let ((defined-syms_0 + (begin-unsafe + (root-expand-context/inner-defined-syms + (root-expand-context/outer-inner root-ctx_0))))) (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value evaled-ld-h_0 i_0)) - (case-lambda - ((phase_0 linklet_0) - (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (i_0) + (begin + (if i_0 + (call-with-values + (lambda () + (hash-iterate-key+value evaled-ld-h_0 i_0)) + (case-lambda + ((phase_0 linklet_0) (begin - (let ((lst_0 - (linklet-export-variables - linklet_0))) - (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_1) - (begin - (if (pair? lst_1) - (let ((sym_0 - (unsafe-car lst_1))) - (let ((rest_0 - (unsafe-cdr lst_1))) - (begin - (let ((id_0 - (datum->syntax$1 - s_0 - sym_0))) - (begin - (let ((temp11_0 - (make-module-binding.1 - #f - null - #f - #f - unsafe-undefined - unsafe-undefined - 0 - unsafe-undefined - self_0 - phase_0 - sym_0))) - (add-binding!.1 - #f - #f - id_0 - temp11_0 - phase_0)) - (add-defined-sym! - defined-syms_0 - phase_0 - sym_0 - id_0))) - (for-loop_1 rest_0)))) - (values))))))) - (for-loop_1 lst_0)))) - (void)) - (for-loop_0 - (hash-iterate-next evaled-ld-h_0 i_0)))) - (args - (raise-binding-result-arity-error 2 args)))) - (values))))))) - (for-loop_0 (hash-iterate-first evaled-ld-h_0)))) - (void) - root-ctx_0)))))))) + (begin + (let ((lst_0 + (linklet-export-variables + linklet_0))) + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? lst_1) + (let ((sym_0 + (unsafe-car lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (let ((id_0 + (datum->syntax$1 + s_0 + sym_0))) + (begin + (let ((temp11_0 + (make-module-binding.1 + #f + null + #f + #f + unsafe-undefined + unsafe-undefined + 0 + unsafe-undefined + self_0 + phase_0 + sym_0))) + (add-binding!.1 + #f + #f + id_0 + temp11_0 + phase_0)) + (add-defined-sym! + defined-syms_0 + phase_0 + sym_0 + id_0))) + (for-loop_1 rest_0)))) + (values))))))) + (for-loop_1 lst_0)))) + (void)) + (for-loop_0 + (hash-iterate-next evaled-ld-h_0 i_0)))) + (args + (raise-binding-result-arity-error 2 args)))) + (values))))))) + (for-loop_0 (hash-iterate-first evaled-ld-h_0)))) + (void) + root-ctx_0))))))))) (define shift-to-inside-root-context (lambda (root-context_0) (let ((outside-mpi_0 @@ -44096,57 +43514,41 @@ (make-self-module-path-index (module-path-index-resolved outside-mpi_0)))) (if (root-expand-context/outer? root-context_0) - (let ((inner16_0 - (let ((the-struct_0 - (root-expand-context/outer-inner root-context_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner root-context_0))) + (let ((inner16_0 (if (root-expand-context/inner? the-struct_0) - (let ((all-scopes-stx18_0 - (let ((temp19_0 - (begin-unsafe - (root-expand-context/inner-all-scopes-stx - (root-expand-context/outer-inner - root-context_0))))) + (let ((temp19_0 + (begin-unsafe + (root-expand-context/inner-all-scopes-stx + (root-expand-context/outer-inner + root-context_0))))) + (let ((all-scopes-stx18_0 (syntax-module-path-index-shift.1 #f temp19_0 outside-mpi_0 inside-mpi_0 - #f)))) - (let ((app_0 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-counter - the-struct_0))) - (root-expand-context/inner2.1 - inside-mpi_0 - app_0 - app_1 - all-scopes-stx18_0 - app_2 - app_3 - (root-expand-context/inner-lift-key - the-struct_0))))))) + #f))) + (root-expand-context/inner2.1 + inside-mpi_0 + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + all-scopes-stx18_0 + (root-expand-context/inner-defined-syms the-struct_0) + (root-expand-context/inner-counter the-struct_0) + (root-expand-context/inner-lift-key the-struct_0)))) (raise-argument-error 'struct-copy "root-expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion root-context_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - root-context_0))) - (root-expand-context/outer1.1 - inner16_0 - app_0 - app_1 - (root-expand-context/outer-frame-id root-context_0))))) + the-struct_0)))) + (root-expand-context/outer1.1 + inner16_0 + (root-expand-context/outer-post-expansion root-context_0) + (root-expand-context/outer-use-site-scopes root-context_0) + (root-expand-context/outer-frame-id root-context_0)))) (raise-argument-error 'struct-copy "root-expand-context/outer?" @@ -44200,99 +43602,98 @@ mi_0))) (if (module-no-protected? m_0) (void) - (let ((access_0 - (let ((or-part_0 - (module-access - m_0))) + (let ((or-part_0 + (module-access m_0))) + (let ((access_0 (if or-part_0 or-part_0 (module-compute-access! - m_0))))) - (begin + m_0)))) (begin - (letrec* - ((for-loop_1 - (|#%name| - for-loop - (lambda (lst_7) - (begin - (if (pair? - lst_7) - (let ((import-sym_0 - (unsafe-car - lst_7))) - (let ((rest_4 - (unsafe-cdr + (begin + (letrec* + ((for-loop_1 + (|#%name| + for-loop + (lambda (lst_7) + (begin + (if (pair? + lst_7) + (let ((import-sym_0 + (unsafe-car lst_7))) - (begin - (let ((a_0 - (hash-ref - (hash-ref - access_0 - (module-use-phase - mu_0) - hash2610) - import-sym_0 - 'unexported))) - (if (let ((or-part_0 - (eq? - a_0 - 'unexported))) - (if or-part_0 - or-part_0 - (eq? - a_0 - 'protected))) - (let ((guard-insp_0 - (namespace-inspector - (module-instance-namespace - mi_0)))) - (if (let ((or-part_0 - (inspector-superior? - insp6_0 - guard-insp_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (if extra-inspector7_0 - (inspector-superior? - extra-inspector7_0 - guard-insp_0) - #f))) - (if or-part_1 - or-part_1 - (if extra-inspectorsss8_0 - (if extra-inspectorss_0 - (extra-inspectors-allow? - (hash-ref - extra-inspectorss_0 - import-sym_0 + (let ((rest_4 + (unsafe-cdr + lst_7))) + (begin + (let ((a_0 + (hash-ref + (hash-ref + access_0 + (module-use-phase + mu_0) + hash2610) + import-sym_0 + 'unexported))) + (if (let ((or-part_1 + (eq? + a_0 + 'unexported))) + (if or-part_1 + or-part_1 + (eq? + a_0 + 'protected))) + (let ((guard-insp_0 + (namespace-inspector + (module-instance-namespace + mi_0)))) + (if (let ((or-part_1 + (inspector-superior? + insp6_0 + guard-insp_0))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (if extra-inspector7_0 + (inspector-superior? + extra-inspector7_0 + guard-insp_0) + #f))) + (if or-part_2 + or-part_2 + (if extra-inspectorsss8_0 + (if extra-inspectorss_0 + (extra-inspectors-allow? + (hash-ref + extra-inspectorss_0 + import-sym_0 + #f) + guard-insp_0) #f) - guard-insp_0) - #f) - #f))))) - (void) - (let ((app_0 - (string-append - "access disallowed by code inspector to ~a variable\n" - " variable: ~s\n" - " from module: ~a"))) - (error - 'link - app_0 - a_0 - import-sym_0 - (1/module-path-index-resolve - (namespace-mpi - (module-instance-namespace - mi_0))))))) - (void))) - (for-loop_1 - rest_4)))) - (values))))))) - (for-loop_1 - import-syms_0))) - (void))))) + #f))))) + (void) + (let ((app_0 + (string-append + "access disallowed by code inspector to ~a variable\n" + " variable: ~s\n" + " from module: ~a"))) + (error + 'link + app_0 + a_0 + import-sym_0 + (1/module-path-index-resolve + (namespace-mpi + (module-instance-namespace + mi_0))))))) + (void))) + (for-loop_1 + rest_4)))) + (values))))))) + (for-loop_1 + import-syms_0))) + (void)))))) (for-loop_0 rest_0 rest_1 @@ -44310,28 +43711,28 @@ (let ((m_0 (module-instance-module mi_0))) (if (module-no-protected? m_0) #t - (let ((access_0 - (let ((or-part_0 (module-access m_0))) - (if or-part_0 or-part_0 (module-compute-access! m_0))))) - (let ((a_0 - (hash-ref - (hash-ref access_0 phase_0 hash2610) - sym_0 - 'unexported))) - (if (let ((or-part_0 (eq? a_0 'unexported))) - (if or-part_0 or-part_0 (eq? a_0 'protected))) - (let ((guard-insp_0 - (namespace-inspector (module-instance-namespace mi_0)))) - (let ((or-part_0 - (if insp_0 - (inspector-superior? insp_0 guard-insp_0) - #f))) - (if or-part_0 - or-part_0 - (inspector-superior? - (current-code-inspector) - guard-insp_0)))) - #t))))))) + (let ((or-part_0 (module-access m_0))) + (let ((access_0 + (if or-part_0 or-part_0 (module-compute-access! m_0)))) + (let ((a_0 + (hash-ref + (hash-ref access_0 phase_0 hash2610) + sym_0 + 'unexported))) + (if (let ((or-part_1 (eq? a_0 'unexported))) + (if or-part_1 or-part_1 (eq? a_0 'protected))) + (let ((guard-insp_0 + (namespace-inspector (module-instance-namespace mi_0)))) + (let ((or-part_1 + (if insp_0 + (inspector-superior? insp_0 guard-insp_0) + #f))) + (if or-part_1 + or-part_1 + (inspector-superior? + (current-code-inspector) + guard-insp_0)))) + #t)))))))) (define cell.1$3 (unsafe-make-place-local (make-weak-hasheq))) (define module-cache-place-init! (lambda () (unsafe-place-local-set! cell.1$3 (make-weak-hasheq)))) @@ -44385,10 +43786,13 @@ c7_0) (let ((l_0 (hash-ref h_0 'stx-data #f))) (if l_0 - (instantiate-linklet - (begin-unsafe - (eval-linklet (force-compile-linklet l_0))) - (list deserialize-instance data-instance_0)) + (let ((app_0 + (begin-unsafe + (eval-linklet + (force-compile-linklet l_0))))) + (instantiate-linklet + app_0 + (list deserialize-instance data-instance_0))) (if (eq? (hash-ref h_0 'module->namespace #f) 'empty) @@ -44854,17 +44258,19 @@ instantiate-body (lambda () (begin - (instantiate-linklet - phase-linklet_0 - (list* - syntax-literals-instance_0 - module-body-instance-instance_0 - import-instances_0) - (begin-unsafe - (definitions-variables - (namespace->definitions - ns_2 - phase-level_0))))))))) + (let ((app_0 + (list* + syntax-literals-instance_0 + module-body-instance-instance_0 + import-instances_0))) + (instantiate-linklet + phase-linklet_0 + app_0 + (begin-unsafe + (definitions-variables + (namespace->definitions + ns_2 + phase-level_0)))))))))) (if (begin-unsafe (eq? phase-level_0 @@ -45195,19 +44601,23 @@ (let ((data-instance_0 (if (compiled-in-memory? c_0) (make-data-instance-from-compiled-in-memory c_0) - (instantiate-linklet - (let ((l_0 (hash-ref h_0 'data))) - (begin-unsafe (eval-linklet (force-compile-linklet l_0)))) - (list deserialize-instance))))) + (let ((app_0 + (let ((l_0 (hash-ref h_0 'data))) + (begin-unsafe + (eval-linklet (force-compile-linklet l_0)))))) + (instantiate-linklet app_0 (list deserialize-instance)))))) (let ((declaration-instance_0 (if (if (compiled-in-memory? c_0) (compiled-in-memory-original-self c_0) #f) (make-declaration-instance-from-compiled-in-memory c_0) - (instantiate-linklet - (let ((l_0 (hash-ref h_0 'decl))) - (begin-unsafe (eval-linklet (force-compile-linklet l_0)))) - (list deserialize-instance data-instance_0))))) + (let ((app_0 + (let ((l_0 (hash-ref h_0 'decl))) + (begin-unsafe + (eval-linklet (force-compile-linklet l_0)))))) + (instantiate-linklet + app_0 + (list deserialize-instance data-instance_0)))))) (values dh_0 h_0 data-instance_0 declaration-instance_0)))) (args (raise-binding-result-arity-error 2 args)))))) (define compiled-module->declaration-instance @@ -45236,21 +44646,18 @@ (compiled-in-memory-mpis cim_0)))) (define make-declaration-instance-from-compiled-in-memory (lambda (cim_0) - (let ((app_0 (compiled-in-memory-original-self cim_0))) - (let ((app_1 (compiled-in-memory-requires cim_0))) - (let ((app_2 (compiled-in-memory-provides cim_0))) - (make-instance - 'decl - #f - 'constant - 'self-mpi - app_0 - 'requires - app_1 - 'provides - app_2 - 'phase-to-link-modules - (compiled-in-memory-phase-to-link-module-uses cim_0))))))) + (make-instance + 'decl + #f + 'constant + 'self-mpi + (compiled-in-memory-original-self cim_0) + 'requires + (compiled-in-memory-requires cim_0) + 'provides + (compiled-in-memory-provides cim_0) + 'phase-to-link-modules + (compiled-in-memory-phase-to-link-module-uses cim_0)))) (define make-syntax-literal-data-instance-from-compiled-in-memory (lambda (cim_0) (make-instance @@ -45639,43 +45046,20 @@ (let ((linklet-directory1_0 (normalize-to-linklet-directory (compiled-in-memory-linklet-directory c_0)))) - (let ((app_0 (compiled-in-memory-original-self c_0))) - (let ((app_1 (compiled-in-memory-requires c_0))) - (let ((app_2 (compiled-in-memory-provides c_0))) - (let ((app_3 - (compiled-in-memory-phase-to-link-module-uses c_0))) - (let ((app_4 - (compiled-in-memory-compile-time-inspector c_0))) - (let ((app_5 - (compiled-in-memory-phase-to-link-extra-inspectorsss - c_0))) - (let ((app_6 (compiled-in-memory-mpis c_0))) - (let ((app_7 - (compiled-in-memory-syntax-literals c_0))) - (let ((app_8 - (compiled-in-memory-pre-compiled-in-memorys - c_0))) - (let ((app_9 - (compiled-in-memory-post-compiled-in-memorys - c_0))) - (let ((app_10 - (compiled-in-memory-namespace-scopes - c_0))) - (compiled-in-memory1.1 - linklet-directory1_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (compiled-in-memory-purely-functional? - c_0)))))))))))))) + (compiled-in-memory1.1 + linklet-directory1_0 + (compiled-in-memory-original-self c_0) + (compiled-in-memory-requires c_0) + (compiled-in-memory-provides c_0) + (compiled-in-memory-phase-to-link-module-uses c_0) + (compiled-in-memory-compile-time-inspector c_0) + (compiled-in-memory-phase-to-link-extra-inspectorsss c_0) + (compiled-in-memory-mpis c_0) + (compiled-in-memory-syntax-literals c_0) + (compiled-in-memory-pre-compiled-in-memorys c_0) + (compiled-in-memory-post-compiled-in-memorys c_0) + (compiled-in-memory-namespace-scopes c_0) + (compiled-in-memory-purely-functional? c_0))) (raise-argument-error 'struct-copy "compiled-in-memory?" c_0)))))) (define 1/module-compiled-name (|#%name| @@ -45787,40 +45171,21 @@ temp11_1 temp10_1 temp12_0))))))) - (let ((app_0 (compiled-in-memory-original-self c_0))) - (let ((app_1 (compiled-in-memory-requires c_0))) - (let ((app_2 (compiled-in-memory-provides c_0))) - (let ((app_3 - (compiled-in-memory-phase-to-link-module-uses - c_0))) - (let ((app_4 - (compiled-in-memory-compile-time-inspector - c_0))) - (let ((app_5 - (compiled-in-memory-phase-to-link-extra-inspectorsss - c_0))) - (let ((app_6 (compiled-in-memory-mpis c_0))) - (let ((app_7 - (compiled-in-memory-syntax-literals - c_0))) - (let ((app_8 - (compiled-in-memory-namespace-scopes - c_0))) - (compiled-in-memory1.1 - linklet-directory9_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - pre-compiled-in-memorys_0 - post-compiled-in-memorys_0 - app_8 - (compiled-in-memory-purely-functional? - c_0)))))))))))) + (compiled-in-memory1.1 + linklet-directory9_0 + (compiled-in-memory-original-self c_0) + (compiled-in-memory-requires c_0) + (compiled-in-memory-provides c_0) + (compiled-in-memory-phase-to-link-module-uses c_0) + (compiled-in-memory-compile-time-inspector c_0) + (compiled-in-memory-phase-to-link-extra-inspectorsss + c_0) + (compiled-in-memory-mpis c_0) + (compiled-in-memory-syntax-literals c_0) + pre-compiled-in-memorys_0 + post-compiled-in-memorys_0 + (compiled-in-memory-namespace-scopes c_0) + (compiled-in-memory-purely-functional? c_0))) (raise-argument-error 'struct-copy "compiled-in-memory?" @@ -46024,41 +45389,21 @@ temp6_1 temp5_1 temp7_0))))))) - (let ((app_0 (compiled-in-memory-original-self n-c_0))) - (let ((app_1 (compiled-in-memory-requires n-c_0))) - (let ((app_2 (compiled-in-memory-provides n-c_0))) - (let ((app_3 - (compiled-in-memory-phase-to-link-module-uses - n-c_0))) - (let ((app_4 - (compiled-in-memory-compile-time-inspector - n-c_0))) - (let ((app_5 - (compiled-in-memory-phase-to-link-extra-inspectorsss - n-c_0))) - (let ((app_6 - (compiled-in-memory-mpis n-c_0))) - (let ((app_7 - (compiled-in-memory-syntax-literals - n-c_0))) - (let ((app_8 - (compiled-in-memory-namespace-scopes - n-c_0))) - (compiled-in-memory1.1 - linklet-directory4_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - pre-compiled-in-memorys_0 - post-compiled-in-memorys_0 - app_8 - (compiled-in-memory-purely-functional? - n-c_0)))))))))))) + (compiled-in-memory1.1 + linklet-directory4_0 + (compiled-in-memory-original-self n-c_0) + (compiled-in-memory-requires n-c_0) + (compiled-in-memory-provides n-c_0) + (compiled-in-memory-phase-to-link-module-uses n-c_0) + (compiled-in-memory-compile-time-inspector n-c_0) + (compiled-in-memory-phase-to-link-extra-inspectorsss + n-c_0) + (compiled-in-memory-mpis n-c_0) + (compiled-in-memory-syntax-literals n-c_0) + pre-compiled-in-memorys_0 + post-compiled-in-memorys_0 + (compiled-in-memory-namespace-scopes n-c_0) + (compiled-in-memory-purely-functional? n-c_0))) (raise-argument-error 'struct-copy "compiled-in-memory?" @@ -46247,118 +45592,118 @@ (if (eq? modules-being-compiled4_0 unsafe-undefined) (make-hasheq) modules-being-compiled4_0))) - (let ((full-module-name_0 - (let ((parent-full-name_0 - (compile-context-full-module-name cctx12_0))) + (let ((parent-full-name_0 + (compile-context-full-module-name cctx12_0))) + (let ((full-module-name_0 (let ((name_0 (syntax-e$1 (parsed-module-name-id p11_0)))) (let ((parent-full-name_1 parent-full-name_0)) (if parent-full-name_1 - (append - (if (list? parent-full-name_1) - parent-full-name_1 - (list parent-full-name_1)) - (list name_0)) - name_0)))))) - (let ((compiled-submodules_0 - (parsed-module-compiled-submodules p11_0))) - (let ((get-submodules_0 - (|#%name| - get-submodules - (lambda (star?_0) - (begin - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 i_0) - (begin - (if i_0 - (call-with-values - (lambda () - (hash-iterate-key+value - compiled-submodules_0 - i_0)) - (case-lambda - ((name_0 star?+compiled_0) - (let ((fold-var_1 - (if (eq? - star?_0 - (car star?+compiled_0)) - (let ((fold-var_1 - (cons - (cons - name_0 - (if (if need-compiled-submodule-rename?5_0 - (not - (parsed-module-compiled-module - p11_0)) - #f) - (update-submodule-names - (cdr - star?+compiled_0) - name_0 - full-module-name_0) - (cdr - star?+compiled_0))) - fold-var_0))) - (values fold-var_1)) - fold-var_0))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - compiled-submodules_0 - i_0)))) - (args - (raise-binding-result-arity-error - 2 - args)))) - fold-var_0)))))) - (for-loop_0 - null - (hash-iterate-first - compiled-submodules_0)))))))))) - (let ((pre-submodules_0 - (let ((temp33_0 (get-submodules_0 #f))) - (sort.1 #f car temp33_0 symbolnamespace?_0 - ''empty - ''#f)))))))))) + 'lambda + '() + (begin-unsafe + (list + get-syntax-literal!-id + root-ctx-pos_0))) + (if empty-result-for-module->namespace?_0 + ''empty + ''#f))))))))))) (if to-correlated-linklet?17_0 (begin-unsafe (correlated-linklet1.1 @@ -46808,21 +46154,23 @@ (begin0 (call-with-values (lambda () - (compile-linklet - s_0 - 'syntax-literals - (vector - deserialize-instance - empty-top-syntax-literal-instance - empty-syntax-literals-data-instance - empty-instance-instance) - (lambda (inst_0) - (values - inst_0 - #f)) - (if serializable?16_0 - '(serializable) - '()))) + (let ((app_0 + (vector + deserialize-instance + empty-top-syntax-literal-instance + empty-syntax-literals-data-instance + empty-instance-instance))) + (compile-linklet + s_0 + 'syntax-literals + app_0 + (lambda (inst_0) + (values + inst_0 + #f)) + (if serializable?16_0 + '(serializable) + '())))) (case-lambda ((linklet_0 new-keys_0) @@ -46842,64 +46190,68 @@ (null? (syntax-literals-stxes syntax-literals_0)))) - (let ((s_0 - (let ((app_0 - (list - 'define-values - (list - deserialized-syntax-vector-id) - (list* - 'make-vector - (syntax-literals-count - syntax-literals_0) - '(#f))))) - (list* - 'linklet - (list - deserialize-imports - (list - mpi-vector-id)) - (list - deserialized-syntax-vector-id - deserialize-syntax-id) - app_0 - (begin - (if log-performance? - (start-performance-region - 'compile - 'module - 'serialize) - (void)) - (begin0 - (generate-lazy-syntax-literals-data! - syntax-literals_0 - mpis_0) - (if log-performance? - (end-performance-region) - (void)))))))) - (if to-correlated-linklet?17_0 - (begin-unsafe - (correlated-linklet1.1 - s_0 - 'syntax-literals-data - #f)) - (begin - (if log-performance? - (start-performance-region - 'compile - 'module - 'linklet) - (void)) - (begin0 - (compile-linklet - s_0 - 'syntax-literals-data - #f - #f - '(serializable)) + (let ((app_0 + (list + deserialize-imports + (list + mpi-vector-id)))) + (let ((s_0 + (let ((app_1 + (list + deserialized-syntax-vector-id + deserialize-syntax-id))) + (let ((app_2 + (list + 'define-values + (list + deserialized-syntax-vector-id) + (list* + 'make-vector + (syntax-literals-count + syntax-literals_0) + '(#f))))) + (list* + 'linklet + app_0 + app_1 + app_2 + (begin + (if log-performance? + (start-performance-region + 'compile + 'module + 'serialize) + (void)) + (begin0 + (generate-lazy-syntax-literals-data! + syntax-literals_0 + mpis_0) + (if log-performance? + (end-performance-region) + (void))))))))) + (if to-correlated-linklet?17_0 + (begin-unsafe + (correlated-linklet1.1 + s_0 + 'syntax-literals-data + #f)) + (begin (if log-performance? - (end-performance-region) - (void)))))) + (start-performance-region + 'compile + 'module + 'linklet) + (void)) + (begin0 + (compile-linklet + s_0 + 'syntax-literals-data + #f + #f + '(serializable)) + (if log-performance? + (end-performance-region) + (void))))))) #f) #f))) (let ((data-linklet_0 @@ -47510,13 +46862,13 @@ (eval-correlated-linklet (hash-ref orig-h_0 key_0)))))))) (let ((data-instance_0 - (instantiate-linklet - (eval-metadata-linklet_0 'data) - (list deserialize-instance)))) + (let ((app_0 (eval-metadata-linklet_0 'data))) + (instantiate-linklet app_0 (list deserialize-instance))))) (let ((declaration-instance_0 - (instantiate-linklet - (eval-metadata-linklet_0 'decl) - (list deserialize-instance data-instance_0)))) + (let ((app_0 (eval-metadata-linklet_0 'decl))) + (instantiate-linklet + app_0 + (list deserialize-instance data-instance_0))))) (let ((decl_0 (|#%name| decl @@ -48585,19 +47937,13 @@ phase-shift_0) name_0 val_0)))) - (let ((temp31_1 - temp31_0) - (temp30_1 - temp30_0) - (temp29_1 - temp29_0)) - (make-instance-instance.1 - temp31_1 - temp30_1 - phase-ns_0 - phase-shift_0 - temp29_1 - temp32_0))))))))) + (make-instance-instance.1 + temp31_0 + temp30_0 + phase-ns_0 + phase-shift_0 + temp29_0 + temp32_0)))))))) (let ((linklet_0 (force-compile-linklet (hash-ref @@ -48628,29 +47974,31 @@ instantiate (lambda (tail?_0) (begin - (instantiate-linklet - linklet_0 - (list* - top-level-instance - link-instance_0 - inst_0 - import-instances_0) - (let ((phase-shift_1 - (let ((app_0 - (phase+ - pos_0 - phase-shift_0))) - (phase- - app_0 - (namespace-0-phase - ns9_0))))) - (begin-unsafe - (definitions-variables - (namespace->definitions - ns9_0 - phase-shift_1)))) - (not - tail?_0))))))) + (let ((app_0 + (list* + top-level-instance + link-instance_0 + inst_0 + import-instances_0))) + (instantiate-linklet + linklet_0 + app_0 + (let ((phase-shift_1 + (let ((app_1 + (phase+ + pos_0 + phase-shift_0))) + (phase- + app_1 + (namespace-0-phase + ns9_0))))) + (begin-unsafe + (definitions-variables + (namespace->definitions + ns9_0 + phase-shift_1)))) + (not + tail?_0)))))))) (if (begin-unsafe (eq? pos_0 @@ -49150,11 +48498,9 @@ (list app_0 (list - (let ((app_1 - (lifted-bind-ids lift_0))) - (list - app_1 - (lifted-bind-rhs lift_0)))) + (list + (lifted-bind-ids lift_0) + (lifted-bind-rhs lift_0))) body_1))))) (values body_2)))) (for-loop_0 body_2 rest_0)))) @@ -49208,14 +48554,12 @@ core-stx phase13_0) 'define-values))) - (let ((app_2 - (lifted-bind-ids - lift_0))) - (list - app_1 - app_2 - (lifted-bind-rhs - lift_0))))) + (list + app_1 + (lifted-bind-ids + lift_0) + (lifted-bind-rhs + lift_0)))) lift_0)) fold-var_0))) (values fold-var_1)))) @@ -49239,17 +48583,14 @@ (let ((lift_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (let ((app_0 (lifted-bind-ids lift_0))) - (let ((app_1 (lifted-bind-keys lift_0))) - (list - app_0 - app_1 - (lifted-bind-rhs lift_0)))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) + (cons + (list + (lifted-bind-ids lift_0) + (lifted-bind-keys lift_0) + (lifted-bind-rhs lift_0)) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null lifts_0)))))) (define struct:module-lift-context @@ -50098,16 +49439,14 @@ (expand-context/inner-stops (root-expand-context/outer-inner ctx_0))))) (begin-unsafe (eq? fs_0 empty-free-id-set)))) - (let ((app_0 - (begin-unsafe - (expand-context/inner-stops - (root-expand-context/outer-inner ctx_0))))) - (free-id-set-member? - app_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))) - id_0)) + (free-id-set-member? + (begin-unsafe + (expand-context/inner-stops + (root-expand-context/outer-inner ctx_0))) + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))) + id_0) #f) (begin (let ((obs_0 @@ -50120,53 +49459,53 @@ (call-expand-observe obs_0 'stop/return s_0)) (void))) s_0) - (let ((binding_0 - (let ((temp103_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))))) - (resolve+shift.1 'ambiguous #f null #t #f id_0 temp103_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 (call-expand-observe obs_0 'resolve id_0) (void))) - (if (eq? binding_0 'ambiguous) - (raise-ambiguous-error id_0 ctx_0) - (if (not binding_0) - (expand-implicit - '|#%top| - (substitute-alternate-id s_0 alternate-id_0) - ctx_0 - s_0) - (call-with-values - (lambda () - (let ((temp117_0 (if alternate-id_0 s_0 #f))) - (let ((temp118_0 - (begin-unsafe - (expand-context/inner-in-local-expand? - (root-expand-context/outer-inner ctx_0))))) - (let ((temp117_1 temp117_0)) - (lookup.1 - temp117_1 - temp118_0 - binding_0 - ctx_0 - id_0))))) - (case-lambda - ((t_0 primitive?_0 insp-of-t_0 protected?_0) - (dispatch.1 - #f - t_0 - insp-of-t_0 - s_0 - id_0 - ctx_0 - binding_0 - primitive?_0 - protected?_0)) - (args (raise-binding-result-arity-error 4 args)))))))))))) + (let ((temp103_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) + (let ((binding_0 + (resolve+shift.1 'ambiguous #f null #t #f id_0 temp103_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 (call-expand-observe obs_0 'resolve id_0) (void))) + (if (eq? binding_0 'ambiguous) + (raise-ambiguous-error id_0 ctx_0) + (if (not binding_0) + (expand-implicit + '|#%top| + (substitute-alternate-id s_0 alternate-id_0) + ctx_0 + s_0) + (call-with-values + (lambda () + (let ((temp117_0 (if alternate-id_0 s_0 #f))) + (let ((temp118_0 + (begin-unsafe + (expand-context/inner-in-local-expand? + (root-expand-context/outer-inner ctx_0))))) + (let ((temp117_1 temp117_0)) + (lookup.1 + temp117_1 + temp118_0 + binding_0 + ctx_0 + id_0))))) + (case-lambda + ((t_0 primitive?_0 insp-of-t_0 protected?_0) + (dispatch.1 + #f + t_0 + insp-of-t_0 + s_0 + id_0 + ctx_0 + binding_0 + primitive?_0 + protected?_0)) + (args (raise-binding-result-arity-error 4 args))))))))))))) (define expand-id-application-form.1 (|#%name| expand-id-application-form @@ -50182,16 +49521,14 @@ (expand-context/inner-stops (root-expand-context/outer-inner ctx11_0))))) (begin-unsafe (eq? fs_0 empty-free-id-set)))) - (let ((app_0 - (begin-unsafe - (expand-context/inner-stops - (root-expand-context/outer-inner ctx11_0))))) - (free-id-set-member? - app_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx11_0))) - id_0)) + (free-id-set-member? + (begin-unsafe + (expand-context/inner-stops + (root-expand-context/outer-inner ctx11_0))) + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx11_0))) + id_0) #f) (begin (let ((obs_0 @@ -50204,82 +49541,76 @@ (call-expand-observe obs_0 'stop/return s10_0)) (void))) s10_0) - (let ((binding_0 - (let ((temp120_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx11_0))))) - (resolve+shift.1 - 'ambiguous - #f - null - #t - #f - id_0 - temp120_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx11_0))))) - (if obs_0 (call-expand-observe obs_0 'resolve id_0) (void))) - (if (eq? binding_0 'ambiguous) - (begin - (if fail-non-transformer8_0 - (|#%app| fail-non-transformer8_0) - (void)) - (raise-ambiguous-error id_0 ctx11_0)) - (if (not binding_0) + (let ((temp120_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx11_0))))) + (let ((binding_0 + (resolve+shift.1 'ambiguous #f null #t #f id_0 temp120_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx11_0))))) + (if obs_0 (call-expand-observe obs_0 'resolve id_0) (void))) + (if (eq? binding_0 'ambiguous) (begin (if fail-non-transformer8_0 (|#%app| fail-non-transformer8_0) (void)) - (expand-implicit - '|#%app| - (substitute-alternate-id s10_0 alternate-id12_0) - ctx11_0 - id_0)) - (call-with-values - (lambda () - (let ((temp126_0 - (if alternate-id12_0 - (car (syntax-e/no-taint s10_0)) - #f))) - (let ((temp127_0 - (begin-unsafe - (expand-context/inner-in-local-expand? - (root-expand-context/outer-inner ctx11_0))))) - (let ((temp126_1 temp126_0)) - (lookup.1 - temp126_1 - temp127_0 - binding_0 + (raise-ambiguous-error id_0 ctx11_0)) + (if (not binding_0) + (begin + (if fail-non-transformer8_0 + (|#%app| fail-non-transformer8_0) + (void)) + (expand-implicit + '|#%app| + (substitute-alternate-id s10_0 alternate-id12_0) + ctx11_0 + id_0)) + (call-with-values + (lambda () + (let ((temp126_0 + (if alternate-id12_0 + (car (syntax-e/no-taint s10_0)) + #f))) + (let ((temp127_0 + (begin-unsafe + (expand-context/inner-in-local-expand? + (root-expand-context/outer-inner + ctx11_0))))) + (let ((temp126_1 temp126_0)) + (lookup.1 + temp126_1 + temp127_0 + binding_0 + ctx11_0 + id_0))))) + (case-lambda + ((t_0 primitive?_0 insp-of-t_0 protected?_0) + (if (variable? t_0) + (begin + (if fail-non-transformer8_0 + (|#%app| fail-non-transformer8_0) + (void)) + (expand-implicit + '|#%app| + (substitute-alternate-id s10_0 alternate-id12_0) ctx11_0 - id_0))))) - (case-lambda - ((t_0 primitive?_0 insp-of-t_0 protected?_0) - (if (variable? t_0) - (begin - (if fail-non-transformer8_0 - (|#%app| fail-non-transformer8_0) - (void)) - (expand-implicit - '|#%app| - (substitute-alternate-id s10_0 alternate-id12_0) + id_0)) + (dispatch.1 + fail-non-transformer8_0 + t_0 + insp-of-t_0 + s10_0 + id_0 ctx11_0 - id_0)) - (dispatch.1 - fail-non-transformer8_0 - t_0 - insp-of-t_0 - s10_0 - id_0 - ctx11_0 - binding_0 - primitive?_0 - protected?_0))) - (args - (raise-binding-result-arity-error 4 args)))))))))))))) + binding_0 + primitive?_0 + protected?_0))) + (args + (raise-binding-result-arity-error 4 args))))))))))))))) (define expand-implicit (lambda (sym_0 s_0 ctx_0 trigger-id_0) (if (begin-unsafe (expand-context/outer-only-immediate? ctx_0)) @@ -50298,16 +49629,14 @@ (expand-context/inner-stops (root-expand-context/outer-inner ctx_0))))) (begin-unsafe (eq? fs_0 empty-free-id-set)))) - (let ((app_0 - (begin-unsafe - (expand-context/inner-stops - (root-expand-context/outer-inner ctx_0))))) - (free-id-set-member? - app_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))) - id_0)) + (free-id-set-member? + (begin-unsafe + (expand-context/inner-stops + (root-expand-context/outer-inner ctx_0))) + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))) + id_0) #f) (begin (let ((obs_0 @@ -50320,11 +49649,11 @@ (call-expand-observe obs_0 'stop/return s_0)) (void))) s_0) - (let ((b_0 - (let ((temp138_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0))))) + (let ((temp138_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) + (let ((b_0 (resolve+shift.1 'ambiguous #f @@ -50332,125 +49661,135 @@ #t #f id_0 - temp138_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner ctx_0))))) - (if obs_0 (call-expand-observe obs_0 'resolve id_0) (void))) - (if (eq? b_0 'ambiguous) - (raise-ambiguous-error id_0 ctx_0) - (call-with-values - (lambda () - (if b_0 - (lookup.1 #f #f b_0 ctx_0 id_0) - (values #f #f #f #f))) - (case-lambda - ((t_0 primitive?_0 insp-of-t_0 protected?_0) - (if (transformer? t_0) - (let ((fail-non-transformer_0 - (if (1/rename-transformer? t_0) - (|#%name| - fail-non-transformer - (lambda () - (begin - (raise-syntax-implicit-error - s_0 - sym_0 - trigger-id_0 - ctx_0)))) - #f))) - (let ((temp146_0 - (make-explicit ctx_0 sym_0 s_0 disarmed-s_0))) - (dispatch-transformer.1 - fail-non-transformer_0 - t_0 - insp-of-t_0 - temp146_0 - id_0 - ctx_0 - b_0))) - (if (core-form? t_0) - (if (if (eq? sym_0 '|#%top|) - (if (eq? (core-form-name t_0) '|#%top|) - (begin-unsafe - (expand-context/inner-in-local-expand? - (root-expand-context/outer-inner ctx_0))) - #f) - #f) - (|dispatch-implicit-#%top-core-form| t_0 s_0 ctx_0) - (dispatch-core-form - t_0 - (make-explicit ctx_0 sym_0 s_0 disarmed-s_0) - ctx_0)) - (let ((tl-id_0 - (if (eq? sym_0 '|#%top|) - (if (begin-unsafe - (root-expand-context/inner-top-level-bind-scope - (root-expand-context/outer-inner - ctx_0))) - (add-scope - s_0 - (begin-unsafe - (root-expand-context/inner-top-level-bind-scope - (root-expand-context/outer-inner + temp138_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'resolve id_0) + (void))) + (if (eq? b_0 'ambiguous) + (raise-ambiguous-error id_0 ctx_0) + (call-with-values + (lambda () + (if b_0 + (lookup.1 #f #f b_0 ctx_0 id_0) + (values #f #f #f #f))) + (case-lambda + ((t_0 primitive?_0 insp-of-t_0 protected?_0) + (if (transformer? t_0) + (let ((fail-non-transformer_0 + (if (1/rename-transformer? t_0) + (|#%name| + fail-non-transformer + (lambda () + (begin + (raise-syntax-implicit-error + s_0 + sym_0 + trigger-id_0 ctx_0)))) - #f) #f))) - (let ((tl-b_0 - (if tl-id_0 - (let ((temp152_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - ctx_0))))) - (resolve.1 - #f - #f - null - #f - tl-id_0 - temp152_0)) - #f))) - (if tl-b_0 - (if (if (begin-unsafe - (expand-context/inner-to-parsed? + (let ((temp146_0 + (make-explicit + ctx_0 + sym_0 + s_0 + disarmed-s_0))) + (dispatch-transformer.1 + fail-non-transformer_0 + t_0 + insp-of-t_0 + temp146_0 + id_0 + ctx_0 + b_0))) + (if (core-form? t_0) + (if (if (eq? sym_0 '|#%top|) + (if (eq? (core-form-name t_0) '|#%top|) + (begin-unsafe + (expand-context/inner-in-local-expand? + (root-expand-context/outer-inner ctx_0))) + #f) + #f) + (|dispatch-implicit-#%top-core-form| + t_0 + s_0 + ctx_0) + (dispatch-core-form + t_0 + (make-explicit ctx_0 sym_0 s_0 disarmed-s_0) + ctx_0)) + (let ((tl-id_0 + (if (eq? sym_0 '|#%top|) + (if (begin-unsafe + (root-expand-context/inner-top-level-bind-scope + (root-expand-context/outer-inner + ctx_0))) + (add-scope + s_0 + (begin-unsafe + (root-expand-context/inner-top-level-bind-scope (root-expand-context/outer-inner - ctx_0))) - (let ((fs_0 + ctx_0)))) + #f) + #f))) + (let ((tl-b_0 + (if tl-id_0 + (let ((temp152_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner + ctx_0))))) + (resolve.1 + #f + #f + null + #f + tl-id_0 + temp152_0)) + #f))) + (if tl-b_0 + (if (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))) + (let ((fs_0 + (begin-unsafe + (expand-context/inner-stops + (root-expand-context/outer-inner + ctx_0))))) + (begin-unsafe + (eq? fs_0 empty-free-id-set))) + #f) + (parsed-id2.1 tl-id_0 tl-b_0 #f) + (begin + (let ((obs_0 (begin-unsafe - (expand-context/inner-stops + (expand-context/inner-observer (root-expand-context/outer-inner ctx_0))))) - (begin-unsafe - (eq? fs_0 empty-free-id-set))) - #f) - (parsed-id2.1 tl-id_0 tl-b_0 #f) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (begin - (call-expand-observe - obs_0 - 'variable - tl-id_0) - (call-expand-observe - obs_0 - 'return - tl-id_0)) - (void))) - tl-id_0)) - (raise-syntax-implicit-error - s_0 - sym_0 - trigger-id_0 - ctx_0))))))) - (args (raise-binding-result-arity-error 4 args))))))))))))) + (if obs_0 + (begin + (call-expand-observe + obs_0 + 'variable + tl-id_0) + (call-expand-observe + obs_0 + 'return + tl-id_0)) + (void))) + tl-id_0)) + (raise-syntax-implicit-error + s_0 + sym_0 + trigger-id_0 + ctx_0))))))) + (args + (raise-binding-result-arity-error 4 args)))))))))))))) (define expand-already-expanded (lambda (s_0 ctx_0) (let ((ae_0 (syntax-e$1 s_0))) @@ -50461,12 +49800,10 @@ or-part_0 (let ((or-part_1 (not - (let ((app_0 - (begin-unsafe - (expand-context/outer-binding-layer ctx_0)))) - (eq? - app_0 - (already-expanded-binding-layer ae_0)))))) + (eq? + (begin-unsafe + (expand-context/outer-binding-layer ctx_0)) + (already-expanded-binding-layer ae_0))))) (if or-part_1 or-part_1 (if (parsed? exp-s_0) @@ -50918,53 +50255,26 @@ (let ((def-ctx-scopes181_1 def-ctx-scopes181_0) (current-introduction-scopes179_1 current-introduction-scopes179_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion - accum-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - accum-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - accum-ctx_0))) - (let ((app_3 - (expand-context/outer-context - accum-ctx_0))) - (let ((app_4 - (expand-context/outer-env - accum-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - accum-ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - accum-ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - accum-ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - accum-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - accum-ctx_0))) - (expand-context/outer1.1 - inner182_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - def-ctx-scopes181_1 - app_6 - app_7 - app_8 - app_9 - current-introduction-scopes179_1 - use-scopes_0 - (expand-context/outer-name - accum-ctx_0)))))))))))))))) + (expand-context/outer1.1 + inner182_0 + (root-expand-context/outer-post-expansion + accum-ctx_0) + (root-expand-context/outer-use-site-scopes + accum-ctx_0) + (root-expand-context/outer-frame-id accum-ctx_0) + (expand-context/outer-context accum-ctx_0) + (expand-context/outer-env accum-ctx_0) + (expand-context/outer-scopes accum-ctx_0) + def-ctx-scopes181_1 + (expand-context/outer-binding-layer accum-ctx_0) + (expand-context/outer-reference-records + accum-ctx_0) + (expand-context/outer-only-immediate? accum-ctx_0) + (expand-context/outer-need-eventually-defined + accum-ctx_0) + current-introduction-scopes179_1 + use-scopes_0 + (expand-context/outer-name accum-ctx_0)))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -51036,7 +50346,7 @@ (root-expand-context/outer-use-site-scopes ctx_0)))) (begin (set-box! b_0 (cons sc_0 (unbox b_0))) - (values (add-scope s_0 sc_0) (list sc_0))))) + (let ((app_0 (add-scope s_0 sc_0))) (values app_0 (list sc_0)))))) (values s_0 null)))) (define matching-frame? (lambda (current-frame-id_0 bind-frame-id_0) @@ -51061,48 +50371,22 @@ (begin-unsafe (expand-context/outer-scopes ctx_0)))))) (let ((inner184_0 (root-expand-context/outer-inner ctx_0))) (let ((scopes183_1 scopes183_0)) - (let ((app_0 (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_2 (root-expand-context/outer-frame-id ctx_0))) - (let ((app_3 (expand-context/outer-context ctx_0))) - (let ((app_4 (expand-context/outer-env ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner184_0 - app_0 - app_1 - app_2 - app_3 - app_4 - scopes183_1 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - ctx_0))))))))))))))))) + (expand-context/outer1.1 + inner184_0 + (root-expand-context/outer-post-expansion ctx_0) + (root-expand-context/outer-use-site-scopes ctx_0) + (root-expand-context/outer-frame-id ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + scopes183_1 + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + (expand-context/outer-name ctx_0))))) (raise-argument-error 'struct-copy "expand-context/outer?" ctx_0))))) (define apply-rename-transformer (lambda (t_0 id_0 ctx_0) @@ -51131,18 +50415,15 @@ (begin-unsafe (expand-context/inner-phase (root-expand-context/outer-inner ctx48_0))))) - (let ((temp188_1 temp188_0) - (temp187_1 temp187_0) - (temp186_1 temp186_0)) - (binding-lookup.1 - in43_0 - out-of-context-as-variable?44_0 - b47_0 - temp186_1 - temp187_1 - temp188_1 - temp189_0 - id49_0)))))))))) + (binding-lookup.1 + in43_0 + out-of-context-as-variable?44_0 + b47_0 + temp186_0 + temp187_0 + temp188_0 + temp189_0 + id49_0))))))))) (define substitute-alternate-id (lambda (s_0 alternate-id_0) (if (not alternate-id_0) @@ -51227,10 +50508,10 @@ temp193_1)))))) (let ((capture-ctx_0 (if (expand-context/outer? ctx_0) - (let ((inner195_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_0))) + (let ((inner195_0 (if (expand-context/inner? the-struct_0) (let ((lift-envs198_0 @@ -51260,169 +50541,91 @@ lift-ctx_0))) (let ((lift-envs198_1 lift-envs198_0)) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_7 - (expand-context/inner-phase - the-struct_0))) - (let ((app_8 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_19 - (expand-context/inner-observer - the-struct_0))) - (let ((app_20 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_21 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_22 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_23 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - lift-key_0 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - lift-ctx_0 - lift-envs198_1 - module-lifts199_0 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + lift-key_0 + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + lift-ctx_0 + lift-envs198_1 + module-lifts199_0 + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))))) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context - ctx_0))) - (let ((app_4 - (expand-context/outer-env - ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner195_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx_0)))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner195_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + (root-expand-context/outer-frame-id + ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes + ctx_0) + (expand-context/outer-binding-layer + ctx_0) + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? + ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -51431,79 +50634,80 @@ (let ((exp-s_0 (expand.1 #f #f s_0 capture-ctx_0))) (let ((lifts_0 - (let ((lifts_0 - (begin-unsafe - (expand-context/inner-lifts - (root-expand-context/outer-inner - capture-ctx_0))))) + (begin-unsafe + (expand-context/inner-lifts + (root-expand-context/outer-inner + capture-ctx_0))))) + (let ((lifts_1 (begin-unsafe (box-clear! - (lift-context-lifts lifts_0)))))) - (let ((with-lifts-s_0 - (if (let ((or-part_0 - (pair? lifts_0))) - (if or-part_0 - or-part_0 - always-wrap?_0)) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx_0))) - (begin - (if expand-lifts?51_0 - (void) - (error - "internal error: to-parsed mode without expanding lifts")) - (wrap-lifts-as-parsed-let - lifts_0 - exp-s_0 - rebuild-s_0 - ctx_0 - (lambda (rhs_0 rhs-ctx_0) - (loop_0 - rhs_0 - #f - rhs-ctx_0)))) - (if begin-form?52_0 - (wrap-lifts-as-begin.1 - unsafe-undefined - unsafe-undefined - lifts_0 - exp-s_0 - phase_0) - (wrap-lifts-as-let - lifts_0 - exp-s_0 - phase_0))) - exp-s_0))) - (if (let ((or-part_0 - (not expand-lifts?51_0))) - (if or-part_0 - or-part_0 - (let ((or-part_1 (null? lifts_0))) - (if or-part_1 - or-part_1 - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx_0))))))) - with-lifts-s_0 - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'letlift-loop - with-lifts-s_0) - (void))) - (loop_0 - with-lifts-s_0 - #f - ctx_0))))))))))))))) + (lift-context-lifts lifts_0))))) + (let ((with-lifts-s_0 + (if (let ((or-part_0 + (pair? lifts_1))) + (if or-part_0 + or-part_0 + always-wrap?_0)) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))) + (begin + (if expand-lifts?51_0 + (void) + (error + "internal error: to-parsed mode without expanding lifts")) + (wrap-lifts-as-parsed-let + lifts_1 + exp-s_0 + rebuild-s_0 + ctx_0 + (lambda (rhs_0 rhs-ctx_0) + (loop_0 + rhs_0 + #f + rhs-ctx_0)))) + (if begin-form?52_0 + (wrap-lifts-as-begin.1 + unsafe-undefined + unsafe-undefined + lifts_1 + exp-s_0 + phase_0) + (wrap-lifts-as-let + lifts_1 + exp-s_0 + phase_0))) + exp-s_0))) + (if (let ((or-part_0 + (not expand-lifts?51_0))) + (if or-part_0 + or-part_0 + (let ((or-part_1 + (null? lifts_1))) + (if or-part_1 + or-part_1 + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))))))) + with-lifts-s_0 + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'letlift-loop + with-lifts-s_0) + (void))) + (loop_0 + with-lifts-s_0 + #f + ctx_0)))))))))))))))) (loop_0 s59_0 always-wrap?54_0 ctx60_0)))))))))) (define expand-transformer.1 (|#%name| @@ -51574,153 +50778,77 @@ (root-expand-context/outer-inner ctx80_0))) empty-free-id-set))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_9 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_10 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_11 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_12 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_13 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_14 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_15 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_16 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_22 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_23 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_24 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - phase_0 - ns_0 - app_8 - app_9 - app_10 - app_11 - app_12 - stops223_0 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? the-struct_0) + phase_0 + ns_0 + (expand-context/inner-just-once? the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + stops223_0 + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts the-struct_0) + (expand-context/inner-lift-envs the-struct_0) + (expand-context/inner-module-lifts the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))) (raise-argument-error 'struct-copy "expand-context/inner?" the-struct_0))))) (let ((only-immediate?217_1 only-immediate?217_0)) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - ctx80_0))) - (let ((app_1 - (root-expand-context/outer-frame-id ctx80_0))) - (let ((app_2 - (expand-context/outer-binding-layer ctx80_0))) - (let ((app_3 - (expand-context/outer-reference-records - ctx80_0))) - (let ((app_4 - (expand-context/outer-need-eventually-defined - ctx80_0))) - (let ((app_5 - (expand-context/outer-current-introduction-scopes - ctx80_0))) - (let ((app_6 - (expand-context/outer-current-use-scopes - ctx80_0))) - (expand-context/outer1.1 - inner220_0 - #f - app_0 - app_1 - context79_0 - empty-env - null - #f - app_2 - app_3 - only-immediate?217_1 - app_4 - app_5 - app_6 - (expand-context/outer-name - ctx80_0)))))))))))) + (expand-context/outer1.1 + inner220_0 + #f + (root-expand-context/outer-use-site-scopes ctx80_0) + (root-expand-context/outer-frame-id ctx80_0) + context79_0 + empty-env + null + #f + (expand-context/outer-binding-layer ctx80_0) + (expand-context/outer-reference-records ctx80_0) + only-immediate?217_1 + (expand-context/outer-need-eventually-defined ctx80_0) + (expand-context/outer-current-introduction-scopes + ctx80_0) + (expand-context/outer-current-use-scopes ctx80_0) + (expand-context/outer-name ctx80_0))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -51931,120 +51059,100 @@ (let ((keys_0 (cadar idss+keyss+rhss_1))) (let ((rhs_0 (caddar idss+keyss+rhss_1))) (let ((exp-rhs_0 (|#%app| parse-rhs_0 rhs_0 rhs-ctx_0))) - (parsed-let-values17.1 - rebuild-s_0 - (list ids_0) - (list (list keys_0 exp-rhs_0)) - (list - (let ((app_0 (cdr idss+keyss+rhss_1))) - (lets-loop_0 + (let ((app_0 (list ids_0))) + (let ((app_1 (list (list keys_0 exp-rhs_0)))) + (parsed-let-values17.1 + rebuild-s_0 app_0 - (if (expand-context/outer? rhs-ctx_0) - (let ((env235_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (env_0 lst_0 lst_1) - (begin - (if (if (pair? lst_0) - (pair? lst_1) - #f) - (let ((id_0 - (unsafe-car lst_0))) - (let ((rest_0 - (unsafe-cdr lst_0))) - (let ((key_0 + app_1 + (list + (let ((app_2 (cdr idss+keyss+rhss_1))) + (lets-loop_0 + app_2 + (if (expand-context/outer? rhs-ctx_0) + (let ((env235_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (env_0 lst_0 lst_1) + (begin + (if (if (pair? lst_0) + (pair? lst_1) + #f) + (let ((id_0 (unsafe-car - lst_1))) - (let ((rest_1 + lst_0))) + (let ((rest_0 (unsafe-cdr - lst_1))) - (let ((val_0 - (local-variable1.1 - id_0))) - (let ((env_1 - (let ((env_1 - (begin-unsafe - (hash-set - env_0 - key_0 - val_0)))) - (values - env_1)))) - (for-loop_0 - env_1 - rest_0 - rest_1))))))) - env_0)))))) - (for-loop_0 - (begin-unsafe - (expand-context/outer-env - rhs-ctx_0)) - ids_0 - keys_0))))) - (let ((inner236_0 - (root-expand-context/outer-inner - rhs-ctx_0))) - (let ((env235_1 env235_0)) - (let ((app_1 - (root-expand-context/outer-post-expansion + lst_0))) + (let ((key_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((val_0 + (local-variable1.1 + id_0))) + (let ((env_1 + (let ((env_1 + (begin-unsafe + (hash-set + env_0 + key_0 + val_0)))) + (values + env_1)))) + (for-loop_0 + env_1 + rest_0 + rest_1))))))) + env_0)))))) + (for-loop_0 + (begin-unsafe + (expand-context/outer-env + rhs-ctx_0)) + ids_0 + keys_0))))) + (let ((inner236_0 + (root-expand-context/outer-inner rhs-ctx_0))) - (let ((app_2 - (root-expand-context/outer-use-site-scopes - rhs-ctx_0))) - (let ((app_3 - (root-expand-context/outer-frame-id - rhs-ctx_0))) - (let ((app_4 - (expand-context/outer-context - rhs-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - rhs-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - rhs-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - rhs-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - rhs-ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - rhs-ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - rhs-ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - rhs-ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - rhs-ctx_0))) - (expand-context/outer1.1 - inner236_0 - app_1 - app_2 - app_3 - app_4 - env235_1 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - rhs-ctx_0))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - rhs-ctx_0)))))))))))))))) + (let ((env235_1 env235_0)) + (expand-context/outer1.1 + inner236_0 + (root-expand-context/outer-post-expansion + rhs-ctx_0) + (root-expand-context/outer-use-site-scopes + rhs-ctx_0) + (root-expand-context/outer-frame-id + rhs-ctx_0) + (expand-context/outer-context + rhs-ctx_0) + env235_1 + (expand-context/outer-scopes + rhs-ctx_0) + (expand-context/outer-def-ctx-scopes + rhs-ctx_0) + (expand-context/outer-binding-layer + rhs-ctx_0) + (expand-context/outer-reference-records + rhs-ctx_0) + (expand-context/outer-only-immediate? + rhs-ctx_0) + (expand-context/outer-need-eventually-defined + rhs-ctx_0) + (expand-context/outer-current-introduction-scopes + rhs-ctx_0) + (expand-context/outer-current-use-scopes + rhs-ctx_0) + (expand-context/outer-name + rhs-ctx_0))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + rhs-ctx_0)))))))))))))))))) (lets-loop_0 idss+keyss+rhss_0 ctx_0))))) (define rename-transformer-target-in-context (lambda (t_0 ctx_0) @@ -52067,19 +51175,14 @@ (let ((srcloc_0 (syntax-srcloc old-s_0))) (if srcloc_0 (if (syntax?$1 new-s_0) - (let ((app_0 (syntax-content* new-s_0))) - (let ((app_1 (syntax-scopes new-s_0))) - (let ((app_2 (syntax-shifted-multi-scopes new-s_0))) - (let ((app_3 (syntax-mpi-shifts new-s_0))) - (let ((app_4 (syntax-props new-s_0))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - srcloc_0 - app_4 - (syntax-inspector new-s_0))))))) + (syntax2.1 + (syntax-content* new-s_0) + (syntax-scopes new-s_0) + (syntax-shifted-multi-scopes new-s_0) + (syntax-mpi-shifts new-s_0) + srcloc_0 + (syntax-props new-s_0) + (syntax-inspector new-s_0)) (raise-argument-error 'struct-copy "syntax?" new-s_0)) new-s_0)))) (define stop-ids->all-stop-ids @@ -52410,10 +51513,10 @@ (get-current-expand-context.1 #f 'syntax-local-make-definition-context))) - (let ((frame-id_0 - (let ((or-part_0 - (begin-unsafe - (root-expand-context/outer-frame-id ctx_0)))) + (let ((or-part_0 + (begin-unsafe + (root-expand-context/outer-frame-id ctx_0)))) + (let ((frame-id_0 (if or-part_0 or-part_0 (let ((or-part_1 @@ -52421,23 +51524,23 @@ (internal-definition-context-frame-id parent-ctx3_0) #f))) - (if or-part_1 or-part_1 (gensym))))))) - (let ((sc_0 (new-scope 'intdef))) - (let ((def-ctx-scopes_0 - (begin-unsafe - (expand-context/outer-def-ctx-scopes ctx_0)))) - (begin - (if def-ctx-scopes_0 - (set-box! - def-ctx-scopes_0 - (cons sc_0 (unbox def-ctx-scopes_0))) - (void)) - (internal-definition-context1.1 - frame-id_0 - sc_0 - add-scope?4_0 - (box null) - parent-ctx3_0)))))))))))) + (if or-part_1 or-part_1 (gensym)))))) + (let ((sc_0 (new-scope 'intdef))) + (let ((def-ctx-scopes_0 + (begin-unsafe + (expand-context/outer-def-ctx-scopes ctx_0)))) + (begin + (if def-ctx-scopes_0 + (set-box! + def-ctx-scopes_0 + (cons sc_0 (unbox def-ctx-scopes_0))) + (void)) + (internal-definition-context1.1 + frame-id_0 + sc_0 + add-scope?4_0 + (box null) + parent-ctx3_0))))))))))))) (|#%name| syntax-local-make-definition-context (case-lambda @@ -52665,59 +51768,35 @@ (let ((inner53_0 (root-expand-context/outer-inner ctx_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context - ctx_0))) - (let ((app_4 - (expand-context/outer-scopes - ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner53_0 - app_0 - app_1 - app_2 - app_3 - tmp-env_0 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - ctx_0))))))))))))))) + (expand-context/outer1.1 + inner53_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + (root-expand-context/outer-frame-id + ctx_0) + (expand-context/outer-context + ctx_0) + tmp-env_0 + (expand-context/outer-scopes + ctx_0) + (expand-context/outer-def-ctx-scopes + ctx_0) + (expand-context/outer-binding-layer + ctx_0) + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? + ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name + ctx_0))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -52927,12 +52006,11 @@ (let ((env-mixin_0 (unsafe-car lst_1))) (let ((rest_0 (unsafe-cdr lst_1))) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (env-mixin-id env-mixin_0) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 fold-var_1 rest_0)))) + (cons + (env-mixin-id env-mixin_0) + fold-var_0))) + (let ((fold-var_2 (values fold-var_1))) + (for-loop_0 fold-var_2 rest_0))))) fold-var_0)))))) (for-loop_0 null lst_0)))))))))) (define 1/internal-definition-context-introduce @@ -53088,11 +52166,10 @@ (begin (if (pair? a_0) (let ((intdef_0 (car a_0))) - (let ((env_2 - (let ((env_2 - (let ((parent-ctx_0 - (internal-definition-context-parent-ctx - intdef_0))) + (let ((parent-ctx_0 + (internal-definition-context-parent-ctx intdef_0))) + (let ((env_2 + (let ((env_2 (let ((parent-env_0 (if parent-ctx_0 (add-intdef-bindings @@ -53151,9 +52228,9 @@ new-env_0))))))))))) (loop_0 parent-env_0 - env-mixins_0))))))) - (values env_2)))) - (for-loop_0 env_2 (cdr a_0)))) + env-mixins_0)))))) + (values env_2)))) + (for-loop_0 env_2 (cdr a_0))))) env_1)))))) (for-loop_0 env_0 x_0)))))) (define add-intdef-scopes.1 @@ -53211,305 +52288,253 @@ (expand-context/inner-phase (root-expand-context/outer-inner ctx33_0))) phase20_0))) - (let ((same-kind?_0 - (let ((or-part_0 - (eq? - context19_0 - (begin-unsafe - (expand-context/outer-context ctx33_0))))) + (let ((or-part_0 + (eq? + context19_0 + (begin-unsafe (expand-context/outer-context ctx33_0))))) + (let ((same-kind?_0 (if or-part_0 or-part_0 (if (list? context19_0) (list? (begin-unsafe (expand-context/outer-context ctx33_0))) - #f))))) - (let ((all-stop-ids_0 - (if stop-ids22_0 - (stop-ids->all-stop-ids stop-ids22_0 phase_0) - #f))) - (let ((def-ctx-scopes_0 - (if (begin-unsafe - (expand-context/outer-def-ctx-scopes ctx33_0)) - (unbox - (begin-unsafe - (expand-context/outer-def-ctx-scopes ctx33_0))) - null))) - (if (expand-context/outer? ctx33_0) - (let ((env62_0 - (add-intdef-bindings - (begin-unsafe (expand-context/outer-env ctx33_0)) - intdefs21_0))) - (let ((use-site-scopes63_0 - (if (let ((or-part_0 (eq? context19_0 'module))) - (if or-part_0 - or-part_0 - (let ((or-part_1 - (eq? context19_0 'module-begin))) - (if or-part_1 - or-part_1 - (list? context19_0))))) - (let ((or-part_0 - (begin-unsafe - (root-expand-context/outer-use-site-scopes - ctx33_0)))) - (if or-part_0 or-part_0 (box null))) - #f))) - (let ((frame-id64_0 - (let ((x_0 - (if (list? intdefs21_0) - (reverse$1 intdefs21_0) - (if (not intdefs21_0) - null - (list intdefs21_0))))) - (begin - #t - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (frame-id_0 a_0) - (begin - (if (pair? a_0) - (let ((intdef_0 (car a_0))) - (let ((frame-id_1 - (let ((frame-id_1 - (let ((i-frame-id_0 - (internal-definition-context-frame-id - intdef_0))) - (if (if frame-id_0 - (if i-frame-id_0 - (not - (eq? - frame-id_0 - i-frame-id_0)) + #f)))) + (let ((all-stop-ids_0 + (if stop-ids22_0 + (stop-ids->all-stop-ids stop-ids22_0 phase_0) + #f))) + (let ((def-ctx-scopes_0 + (if (begin-unsafe + (expand-context/outer-def-ctx-scopes ctx33_0)) + (unbox + (begin-unsafe + (expand-context/outer-def-ctx-scopes ctx33_0))) + null))) + (if (expand-context/outer? ctx33_0) + (let ((env62_0 + (add-intdef-bindings + (begin-unsafe (expand-context/outer-env ctx33_0)) + intdefs21_0))) + (let ((use-site-scopes63_0 + (if (let ((or-part_1 (eq? context19_0 'module))) + (if or-part_1 + or-part_1 + (let ((or-part_2 + (eq? context19_0 'module-begin))) + (if or-part_2 + or-part_2 + (list? context19_0))))) + (let ((or-part_1 + (begin-unsafe + (root-expand-context/outer-use-site-scopes + ctx33_0)))) + (if or-part_1 or-part_1 (box null))) + #f))) + (let ((frame-id64_0 + (let ((x_0 + (if (list? intdefs21_0) + (reverse$1 intdefs21_0) + (if (not intdefs21_0) + null + (list intdefs21_0))))) + (begin + #t + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (frame-id_0 a_0) + (begin + (if (pair? a_0) + (let ((intdef_0 (car a_0))) + (let ((i-frame-id_0 + (internal-definition-context-frame-id + intdef_0))) + (let ((frame-id_1 + (let ((frame-id_1 + (if (if frame-id_0 + (if i-frame-id_0 + (not + (eq? + frame-id_0 + i-frame-id_0)) + #f) #f) - #f) - 'all - (if frame-id_0 - frame-id_0 - i-frame-id_0))))) - (values frame-id_1)))) - (for-loop_0 - frame-id_1 - (cdr a_0)))) - frame-id_0)))))) - (for-loop_0 - (begin-unsafe - (root-expand-context/outer-frame-id - ctx33_0)) - x_0)))))) - (let ((post-expansion65_0 - (let ((pe_0 - (if same-kind?_0 - (if (let ((or-part_0 - (pair? context19_0))) - (if or-part_0 - or-part_0 - (memq - context19_0 - '(module module-begin top-level)))) - (begin-unsafe - (root-expand-context/outer-post-expansion - ctx33_0)) - #f) - #f))) - (if (if intdefs21_0 - (not (null? intdefs21_0)) - #f) - (|#%name| - post-expansion65 - (lambda (s_0) - (begin - (let ((temp71_0 - (apply-post-expansion pe_0 s_0))) - (add-intdef-scopes.1 - unsafe-undefined - #f - temp71_0 - intdefs21_0))))) - pe_0)))) - (let ((scopes66_0 - (append - def-ctx-scopes_0 - (begin-unsafe - (expand-context/outer-scopes ctx33_0))))) - (let ((only-immediate?67_0 (not stop-ids22_0))) - (let ((need-eventually-defined69_0 - (let ((ht_0 + 'all + (if frame-id_0 + frame-id_0 + i-frame-id_0)))) + (values frame-id_1)))) + (for-loop_0 + frame-id_1 + (cdr a_0))))) + frame-id_0)))))) + (for-loop_0 + (begin-unsafe + (root-expand-context/outer-frame-id + ctx33_0)) + x_0)))))) + (let ((post-expansion65_0 + (let ((pe_0 + (if same-kind?_0 + (if (let ((or-part_1 + (pair? context19_0))) + (if or-part_1 + or-part_1 + (memq + context19_0 + '(module module-begin top-level)))) (begin-unsafe - (expand-context/outer-need-eventually-defined - ctx33_0)))) - (if track-to-be-defined?24_0 - ht_0 - (if ht_0 (make-hasheqv) #f))))) - (let ((inner70_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx33_0))) - (if (expand-context/inner? - the-struct_0) - (let ((to-parsed?73_0 - (if to-parsed-ok?23_0 - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx33_0))) - #f))) - (let ((stops77_0 - (free-id-set - phase_0 - (if all-stop-ids_0 - all-stop-ids_0 - null)))) - (let ((to-parsed?73_1 - to-parsed?73_0)) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-phase - the-struct_0))) - (let ((app_8 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_9 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_10 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_11 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_12 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_13 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_14 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_15 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_16 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_18 - (expand-context/inner-observer - the-struct_0))) - (let ((app_19 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_21 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_22 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - to-parsed?73_1 - app_7 - app_8 - #f - app_9 - app_10 - #t - |keep-#%expression?25_0| - stops77_0 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((need-eventually-defined69_1 - need-eventually-defined69_0) - (only-immediate?67_1 - only-immediate?67_0) - (scopes66_1 scopes66_0) - (post-expansion65_1 post-expansion65_0) - (frame-id64_1 frame-id64_0) - (use-site-scopes63_1 - use-site-scopes63_0) - (env62_1 env62_0)) - (let ((app_0 - (expand-context/outer-def-ctx-scopes - ctx33_0))) - (let ((app_1 - (expand-context/outer-binding-layer - ctx33_0))) - (let ((app_2 - (expand-context/outer-reference-records - ctx33_0))) - (let ((app_3 - (expand-context/outer-current-use-scopes - ctx33_0))) - (expand-context/outer1.1 - inner70_0 - post-expansion65_1 - use-site-scopes63_1 - frame-id64_1 - context19_0 - env62_1 - scopes66_1 - app_0 - app_1 - app_2 - only-immediate?67_1 - need-eventually-defined69_1 - null - app_3 - (expand-context/outer-name - ctx33_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx33_0)))))))))) + (root-expand-context/outer-post-expansion + ctx33_0)) + #f) + #f))) + (if (if intdefs21_0 + (not (null? intdefs21_0)) + #f) + (|#%name| + post-expansion65 + (lambda (s_0) + (begin + (let ((temp71_0 + (apply-post-expansion + pe_0 + s_0))) + (add-intdef-scopes.1 + unsafe-undefined + #f + temp71_0 + intdefs21_0))))) + pe_0)))) + (let ((scopes66_0 + (append + def-ctx-scopes_0 + (begin-unsafe + (expand-context/outer-scopes ctx33_0))))) + (let ((only-immediate?67_0 (not stop-ids22_0))) + (let ((need-eventually-defined69_0 + (let ((ht_0 + (begin-unsafe + (expand-context/outer-need-eventually-defined + ctx33_0)))) + (if track-to-be-defined?24_0 + ht_0 + (if ht_0 (make-hasheqv) #f))))) + (let ((inner70_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx33_0))) + (if (expand-context/inner? + the-struct_0) + (let ((to-parsed?73_0 + (if to-parsed-ok?23_0 + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx33_0))) + #f))) + (let ((stops77_0 + (free-id-set + phase_0 + (if all-stop-ids_0 + all-stop-ids_0 + null)))) + (let ((to-parsed?73_1 + to-parsed?73_0)) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + to-parsed?73_1 + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + #f + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + #t + |keep-#%expression?25_0| + stops77_0 + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((need-eventually-defined69_1 + need-eventually-defined69_0) + (only-immediate?67_1 + only-immediate?67_0) + (scopes66_1 scopes66_0) + (post-expansion65_1 + post-expansion65_0) + (frame-id64_1 frame-id64_0) + (use-site-scopes63_1 + use-site-scopes63_0) + (env62_1 env62_0)) + (expand-context/outer1.1 + inner70_0 + post-expansion65_1 + use-site-scopes63_1 + frame-id64_1 + context19_0 + env62_1 + scopes66_1 + (expand-context/outer-def-ctx-scopes + ctx33_0) + (expand-context/outer-binding-layer + ctx33_0) + (expand-context/outer-reference-records + ctx33_0) + only-immediate?67_1 + need-eventually-defined69_1 + null + (expand-context/outer-current-use-scopes + ctx33_0) + (expand-context/outer-name + ctx33_0))))))))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx33_0))))))))))) (define flip-introduction-scopes (lambda (s_0 ctx_0) (flip-scopes @@ -53925,59 +52950,32 @@ (root-expand-context/outer-inner current-ctx_0))) (let ((env74_1 env74_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion - current-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - current-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - current-ctx_0))) - (let ((app_3 - (expand-context/outer-context - current-ctx_0))) - (let ((app_4 - (expand-context/outer-scopes - current-ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - current-ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - current-ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - current-ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - current-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - current-ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - current-ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - current-ctx_0))) - (expand-context/outer1.1 - inner75_0 - app_0 - app_1 - app_2 - app_3 - env74_1 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - current-ctx_0))))))))))))))))) + (expand-context/outer1.1 + inner75_0 + (root-expand-context/outer-post-expansion + current-ctx_0) + (root-expand-context/outer-use-site-scopes + current-ctx_0) + (root-expand-context/outer-frame-id + current-ctx_0) + (expand-context/outer-context current-ctx_0) + env74_1 + (expand-context/outer-scopes current-ctx_0) + (expand-context/outer-def-ctx-scopes + current-ctx_0) + (expand-context/outer-binding-layer + current-ctx_0) + (expand-context/outer-reference-records + current-ctx_0) + (expand-context/outer-only-immediate? + current-ctx_0) + (expand-context/outer-need-eventually-defined + current-ctx_0) + (expand-context/outer-current-introduction-scopes + current-ctx_0) + (expand-context/outer-current-use-scopes + current-ctx_0) + (expand-context/outer-name current-ctx_0))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -54504,15 +53502,13 @@ push-authentic current-expand-context #f - (let ((app_0 - (begin-unsafe - (expand-context/inner-namespace - (root-expand-context/outer-inner ctx_0))))) - (namespace-visit-available-modules! - app_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner ctx_0)))))) + (namespace-visit-available-modules! + (begin-unsafe + (expand-context/inner-namespace + (root-expand-context/outer-inner ctx_0))) + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) (let ((result-s_0 (add-scope use-s_0 sc_0))) (begin (let ((obs_0 @@ -54726,24 +53722,23 @@ (if (pair? lst_0) (let ((r_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((ht_1 - (let ((ht_1 - (let ((key_0 (required-phase r_0))) + (let ((key_0 (required-phase r_0))) + (let ((ht_1 + (let ((ht_1 (let ((xform_0 (lambda (l_0) (cons (required-id r_0) l_0)))) - (let ((key_1 key_0)) - (begin-unsafe - (do-hash-update - 'hash-update - #f - hash-set - ht_0 - key_1 - xform_0 - null))))))) - (values ht_1)))) - (for-loop_0 ht_1 rest_0)))) + (begin-unsafe + (do-hash-update + 'hash-update + #f + hash-set + ht_0 + key_0 + xform_0 + null))))) + (values ht_1)))) + (for-loop_0 ht_1 rest_0))))) ht_0)))))) (for-loop_0 (hasheqv) requireds_0))))) (define 1/syntax-local-module-exports @@ -55023,19 +54018,14 @@ (lambda (v_0) (if (srcloc? v_0) (if (syntax?$1 empty-syntax) - (let ((app_0 (syntax-content* empty-syntax))) - (let ((app_1 (syntax-scopes empty-syntax))) - (let ((app_2 (syntax-shifted-multi-scopes empty-syntax))) - (let ((app_3 (syntax-mpi-shifts empty-syntax))) - (let ((app_4 (syntax-props empty-syntax))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - v_0 - app_4 - (syntax-inspector empty-syntax))))))) + (syntax2.1 + (syntax-content* empty-syntax) + (syntax-scopes empty-syntax) + (syntax-shifted-multi-scopes empty-syntax) + (syntax-mpi-shifts empty-syntax) + v_0 + (syntax-props empty-syntax) + (syntax-inspector empty-syntax)) (raise-argument-error 'struct-copy "syntax?" empty-syntax)) (if (pair? v_0) (to-srcloc-stx (list->vector v_0)) @@ -55052,19 +54042,14 @@ app_2 app_3 (vector-ref v_0 4)))))))) - (let ((app_0 (syntax-content* empty-syntax))) - (let ((app_1 (syntax-scopes empty-syntax))) - (let ((app_2 (syntax-shifted-multi-scopes empty-syntax))) - (let ((app_3 (syntax-mpi-shifts empty-syntax))) - (let ((app_4 (syntax-props empty-syntax))) - (syntax2.1 - app_0 - app_1 - app_2 - app_3 - srcloc2_0 - app_4 - (syntax-inspector empty-syntax)))))))) + (syntax2.1 + (syntax-content* empty-syntax) + (syntax-scopes empty-syntax) + (syntax-shifted-multi-scopes empty-syntax) + (syntax-mpi-shifts empty-syntax) + srcloc2_0 + (syntax-props empty-syntax) + (syntax-inspector empty-syntax))) (raise-argument-error 'struct-copy "syntax?" empty-syntax)) v_0))))) (define 1/syntax-e @@ -56263,13 +55248,11 @@ mod-name_0))) (begin (begin-unsafe - (let ((app_0 - (module-force-bulk-binding - m_0))) - (|#%app| - app_0 - (namespace-bulk-binding-registry - src-namespace10_0)))) + (|#%app| + (module-force-bulk-binding + m_0) + (namespace-bulk-binding-registry + src-namespace10_0))) (with-continuation-mark* push-authentic parameterization-key @@ -56940,19 +55923,18 @@ (let ((temp102_0 (let ((temp104_0 (namespace-mpi ns_0))) (let ((temp105_0 (namespace-phase ns_0))) - (let ((temp104_1 temp104_0)) - (make-module-binding.1 - #f - null - #f - #f - unsafe-undefined - unsafe-undefined - 0 - unsafe-undefined - temp104_1 - temp105_0 - sym33_0)))))) + (make-module-binding.1 + #f + null + #f + #f + unsafe-undefined + unsafe-undefined + 0 + unsafe-undefined + temp104_0 + temp105_0 + sym33_0))))) (let ((temp103_0 (namespace-phase ns_0))) (let ((temp102_1 temp102_0) (temp101_1 temp101_0)) @@ -57325,12 +56307,10 @@ (let ((temp90_0 (reverse$1 (let ((lst_0 - (let ((app_0 - (lifted-parsed-begin-seq exp-s_1))) - (append - app_0 - (list - (lifted-parsed-begin-last exp-s_1)))))) + (append + (lifted-parsed-begin-seq exp-s_1) + (list + (lifted-parsed-begin-last exp-s_1))))) (begin (letrec* ((for-loop_0 @@ -57545,167 +56525,64 @@ s_0 (let ((v_0 (make-expand-context.1 #f #f #f #f #f ns_0))) (if (expand-context/outer? v_0) - (let ((inner139_0 - (let ((the-struct_0 (root-expand-context/outer-inner v_0))) + (let ((the-struct_0 (root-expand-context/outer-inner v_0))) + (let ((inner139_0 (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - #t - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi the-struct_0) + (root-expand-context/inner-module-scopes the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx the-struct_0) + (root-expand-context/inner-defined-syms the-struct_0) + (root-expand-context/inner-counter the-struct_0) + (root-expand-context/inner-lift-key the-struct_0) + (expand-context/inner-to-parsed? the-struct_0) + (expand-context/inner-phase the-struct_0) + (expand-context/inner-namespace the-struct_0) + #t + (expand-context/inner-module-begin-k the-struct_0) + (expand-context/inner-allow-unbound? the-struct_0) + (expand-context/inner-in-local-expand? the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts the-struct_0) + (expand-context/inner-lift-envs the-struct_0) + (expand-context/inner-module-lifts the-struct_0) + (expand-context/inner-require-lifts the-struct_0) + (expand-context/inner-to-module-lifts the-struct_0) + (expand-context/inner-requires+provides the-struct_0) + (expand-context/inner-observer the-struct_0) + (expand-context/inner-for-serializable? the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? the-struct_0) + (expand-context/inner-parsing-expanded? the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 (root-expand-context/outer-post-expansion v_0))) - (let ((app_1 (root-expand-context/outer-use-site-scopes v_0))) - (let ((app_2 (root-expand-context/outer-frame-id v_0))) - (let ((app_3 (expand-context/outer-context v_0))) - (let ((app_4 (expand-context/outer-env v_0))) - (let ((app_5 (expand-context/outer-scopes v_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes v_0))) - (let ((app_7 - (expand-context/outer-binding-layer v_0))) - (let ((app_8 - (expand-context/outer-reference-records - v_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - v_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner139_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - v_0)))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner139_0 + (root-expand-context/outer-post-expansion v_0) + (root-expand-context/outer-use-site-scopes v_0) + (root-expand-context/outer-frame-id v_0) + (expand-context/outer-context v_0) + (expand-context/outer-env v_0) + (expand-context/outer-scopes v_0) + (expand-context/outer-def-ctx-scopes v_0) + (expand-context/outer-binding-layer v_0) + (expand-context/outer-reference-records v_0) + (expand-context/outer-only-immediate? v_0) + (expand-context/outer-need-eventually-defined v_0) + (expand-context/outer-current-introduction-scopes v_0) + (expand-context/outer-current-use-scopes v_0) + (expand-context/outer-name v_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" v_0))))) (case-lambda ((require-lifts_0 lifts_0 exp-s_0) @@ -57782,174 +56659,91 @@ (begin (let ((tl-ctx_0 (if (expand-context/outer? ctx_0) - (let ((inner151_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner ctx_0))) + (let ((inner151_0 (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_9 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_10 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_11 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_12 - (expand-context/inner-stops - the-struct_0))) - (let ((app_13 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_14 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_15 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_16 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_22 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_23 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - phase_1 - ns_0 - just-once?42_0 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - serializable?44_0 - app_21 - app_22 - app_23 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + phase_1 + ns_0 + just-once?42_0 + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + serializable?44_0 + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context - ctx_0))) - (let ((app_4 - (expand-context/outer-env - ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner151_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx_0)))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner151_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + (root-expand-context/outer-frame-id ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -57969,178 +56763,98 @@ (expand-capturing-lifts s_1 (if (expand-context/outer? tl-ctx_0) - (let ((inner157_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - tl-ctx_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner + tl-ctx_0))) + (let ((inner157_0 (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_9 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_10 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_11 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_12 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_13 - (expand-context/inner-stops - the-struct_0))) - (let ((app_14 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_15 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_16 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_17 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_21 - (expand-context/inner-observer - the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_25 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - phase_1 - ns_0 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + phase_1 + ns_0 + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - tl-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - tl-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - tl-ctx_0))) - (let ((app_3 - (expand-context/outer-context - tl-ctx_0))) - (let ((app_4 - (expand-context/outer-env - tl-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - tl-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - tl-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - tl-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - tl-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - tl-ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - tl-ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - tl-ctx_0))) - (expand-context/outer1.1 - inner157_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - #t - app_9 - app_10 - app_11 - (expand-context/outer-name - tl-ctx_0))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner157_0 + (root-expand-context/outer-post-expansion + tl-ctx_0) + (root-expand-context/outer-use-site-scopes + tl-ctx_0) + (root-expand-context/outer-frame-id + tl-ctx_0) + (expand-context/outer-context tl-ctx_0) + (expand-context/outer-env tl-ctx_0) + (expand-context/outer-scopes tl-ctx_0) + (expand-context/outer-def-ctx-scopes + tl-ctx_0) + (expand-context/outer-binding-layer + tl-ctx_0) + (expand-context/outer-reference-records + tl-ctx_0) + #t + (expand-context/outer-need-eventually-defined + tl-ctx_0) + (expand-context/outer-current-introduction-scopes + tl-ctx_0) + (expand-context/outer-current-use-scopes + tl-ctx_0) + (expand-context/outer-name tl-ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -58546,7 +57260,8 @@ (define re-pair (lambda (form-id_0 s_0 r_0) (syntax-rearm$1 - (1/datum->syntax (syntax-disarm$1 s_0) (cons form-id_0 r_0) s_0 s_0) + (let ((app_0 (syntax-disarm$1 s_0))) + (1/datum->syntax app_0 (cons form-id_0 r_0) s_0 s_0)) s_0))) (define expand-capturing-lifts (lambda (s_0 ctx_0) @@ -58562,8 +57277,8 @@ (let ((lift-ctx_0 (let ((temp171_0 (make-top-level-lift ctx_0))) (make-lift-context.1 #f temp171_0)))) - (let ((require-lift-ctx_0 - (let ((wrt-phase_0 (namespace-phase ns_0))) + (let ((wrt-phase_0 (namespace-phase ns_0))) + (let ((require-lift-ctx_0 (let ((do-require_0 (make-parse-top-lifted-require ns_0))) (let ((wrt-phase_1 wrt-phase_0)) @@ -58571,197 +57286,117 @@ (require-lift-context16.1 do-require_0 wrt-phase_1 - (box null)))))))) - (let ((exp-s_0 - (let ((temp173_0 - (if (expand-context/outer? ctx_0) - (let ((inner174_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-stops - the-struct_0))) - (let ((app_16 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_22 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_23 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_24 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - lift-ctx_0 - app_17 - lift-ctx_0 - require-lift-ctx_0 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion + (box null))))))) + (let ((exp-s_0 + (let ((temp173_0 + (if (expand-context/outer? ctx_0) + (let ((the-struct_0 + (root-expand-context/outer-inner ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context - ctx_0))) - (let ((app_4 - (expand-context/outer-env - ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner174_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx_0)))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_0)))) - (expand.1 #f #f s_0 temp173_0)))) - (let ((app_0 - (begin-unsafe - (box-clear! - (require-lift-context-requires - require-lift-ctx_0))))) - (values - app_0 - (begin-unsafe - (box-clear! (lift-context-lifts lift-ctx_0))) - exp-s_0))))))) + (let ((inner174_0 + (if (expand-context/inner? + the-struct_0) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + lift-ctx_0 + (expand-context/inner-lift-envs + the-struct_0) + lift-ctx_0 + require-lift-ctx_0 + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0)))) + (expand-context/outer1.1 + inner174_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + (root-expand-context/outer-frame-id + ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes + ctx_0) + (expand-context/outer-binding-layer + ctx_0) + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? + ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name ctx_0)))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_0)))) + (expand.1 #f #f s_0 temp173_0)))) + (let ((app_0 + (begin-unsafe + (box-clear! + (require-lift-context-requires + require-lift-ctx_0))))) + (values + app_0 + (begin-unsafe + (box-clear! (lift-context-lifts lift-ctx_0))) + exp-s_0)))))))) (if log-performance? (end-performance-region) (void)))))) (define make-parse-top-lifted-require (lambda (ns_0) @@ -59452,121 +58087,121 @@ (namespace->module ns_0 ex-mod-name_0))) - (let ((access_0 - (let ((or-part_0 - (module-access - ex-m_0))) + (let ((or-part_0 + (module-access + ex-m_0))) + (let ((access_0 (if or-part_0 or-part_0 (module-compute-access! - ex-m_0))))) - (begin - (if (if (not - (eq? - 'provided - (hash-ref - (hash-ref - access_0 - ex-phase_0 - hash2610) - ex-sym_0 - #f))) - (if (not - (let ((app_0 - (current-code-inspector))) - (inspector-superior? - app_0 - (namespace-inspector - m-ns_0)))) - (not - (if (module-binding-extra-inspector - binding_0) - (let ((app_0 - (module-binding-extra-inspector - binding_0))) - (inspector-superior? - app_0 - (namespace-inspector - m-ns_0))) - #f)) + ex-m_0)))) + (begin + (if (if (not + (eq? + 'provided + (hash-ref + (hash-ref + access_0 + ex-phase_0 + hash2610) + ex-sym_0 + #f))) + (if (not + (let ((app_0 + (current-code-inspector))) + (inspector-superior? + app_0 + (namespace-inspector + m-ns_0)))) + (not + (if (module-binding-extra-inspector + binding_0) + (let ((app_0 + (module-binding-extra-inspector + binding_0))) + (inspector-superior? + app_0 + (namespace-inspector + m-ns_0))) + #f)) + #f) #f) - #f) - (raise-arguments-error - 'dynamic-require - "name is protected" - "name" - sym4_0 - "module" - mod-name_0) - (void)) - (let ((fail_0 - (|#%name| - fail - (lambda () - (begin + (raise-arguments-error + 'dynamic-require + "name is protected" + "name" + sym4_0 + "module" + mod-name_0) + (void)) + (let ((fail_0 + (|#%name| + fail + (lambda () + (begin + (if (eq? + fail-k_0 + default-dynamic-require-fail-thunk) + (raise-arguments-error + 'dynamic-require + "name's binding is missing" + "name" + sym4_0 + "module" + mod-name_0) + (|#%app| + fail-k_0))))))) + (if (not + (provided-as-transformer? + binding/p_0)) + (namespace-get-variable + m-ns_0 + ex-phase_0 + ex-sym_0 + fail_0) + (let ((missing_0 + (gensym + 'missing))) + (begin + (namespace-module-visit!.1 + phase_0 + ns_0 + mpi_0 + phase_0) + (let ((t_0 + (namespace-get-transformer + m-ns_0 + ex-phase_0 + ex-sym_0 + missing_0))) (if (eq? - fail-k_0 - default-dynamic-require-fail-thunk) - (raise-arguments-error - 'dynamic-require - "name's binding is missing" - "name" - sym4_0 - "module" - mod-name_0) - (|#%app| - fail-k_0))))))) - (if (not - (provided-as-transformer? - binding/p_0)) - (namespace-get-variable - m-ns_0 - ex-phase_0 - ex-sym_0 - fail_0) - (let ((missing_0 - (gensym - 'missing))) - (begin - (namespace-module-visit!.1 - phase_0 - ns_0 - mpi_0 - phase_0) - (let ((t_0 - (namespace-get-transformer - m-ns_0 - ex-phase_0 - ex-sym_0 - missing_0))) - (if (eq? - t_0 - missing_0) - (fail_0) - (let ((tmp-ns_0 - (new-namespace.1 - #t - unsafe-undefined - ns_0))) - (let ((mod-path_0 - (resolved-module-path->module-path - mod-name_0))) - (begin - (1/namespace-require - mod-path_0 - tmp-ns_0) - (with-continuation-mark* - authentic - parameterization-key - (extend-parameterization - (continuation-mark-set-first - #f - parameterization-key) - 1/current-namespace - tmp-ns_0) - (1/eval - sym4_0 - tmp-ns_0)))))))))))))))))))))))))))))))))))))))) + t_0 + missing_0) + (fail_0) + (let ((tmp-ns_0 + (new-namespace.1 + #t + unsafe-undefined + ns_0))) + (let ((mod-path_0 + (resolved-module-path->module-path + mod-name_0))) + (begin + (1/namespace-require + mod-path_0 + tmp-ns_0) + (with-continuation-mark* + authentic + parameterization-key + (extend-parameterization + (continuation-mark-set-first + #f + parameterization-key) + 1/current-namespace + tmp-ns_0) + (1/eval + sym4_0 + tmp-ns_0))))))))))))))))))))))))))))))))))))))))) (case-lambda ((who_0 mod-path_0 sym_0) (do-dynamic-require_0 who_0 mod-path_0 sym_0 unsafe-undefined)) @@ -60059,23 +58694,24 @@ (let ((or-part_1 (hash-ref ht_0 'share-dir #f))) (if or-part_1 or-part_1 (build-path 'up "share"))) "links.rktd")))))) - (let ((app_0 - (if (if (1/use-user-specific-search-paths) - (1/use-collection-link-paths) - #f) - (list - (let ((app_0 (find-system-path 'addon-dir))) - (build-path - app_0 - (get-installation-name ht_0) - "links.rktd"))) - null))) - (append - (list #f) - app_0 - (if (1/use-collection-link-paths) - (add-config-search ht_0 'links-search-files (list lf_0)) - null))))))))) + (let ((app_0 (list #f))) + (let ((app_1 + (if (if (1/use-user-specific-search-paths) + (1/use-collection-link-paths) + #f) + (list + (let ((app_1 (find-system-path 'addon-dir))) + (build-path + app_1 + (get-installation-name ht_0) + "links.rktd"))) + null))) + (append + app_0 + app_1 + (if (1/use-collection-link-paths) + (add-config-search ht_0 'links-search-files (list lf_0)) + null)))))))))) (define cell.1$1 (unsafe-make-place-local (make-weak-hash))) (define collection-place-init! (lambda () (unsafe-place-local-set! cell.1$1 (make-weak-hash)))) @@ -60338,12 +58974,13 @@ (hash-set! ht_0 s_0 - (cons - (box dir_1) - (hash-ref - ht_0 - s_0 - null))))))) + (let ((app_0 (box dir_1))) + (cons + app_0 + (hash-ref + ht_0 + s_0 + null)))))))) (void))) v_0) (hash-for-each @@ -61145,8 +59782,8 @@ (read-config/outer-inner config41_0))) next-readtable32_0))) (if (read-config/outer? config41_0) - (let ((inner53_0 - (let ((the-struct_0 (read-config/outer-inner config41_0))) + (let ((the-struct_0 (read-config/outer-inner config41_0))) + (let ((inner53_0 (if (read-config/inner? the-struct_0) (let ((st57_0 (if reset-graph?33_0 @@ -61159,53 +59796,34 @@ (let ((parameter-override58_1 parameter-override58_0) (st57_1 st57_0)) - (let ((app_0 - (read-config/inner-source the-struct_0))) - (let ((app_1 - (read-config/inner-read-compiled - the-struct_0))) - (let ((app_2 - (read-config/inner-call-with-root-namespace - the-struct_0))) - (let ((app_3 - (read-config/inner-dynamic-require - the-struct_0))) - (let ((app_4 - (read-config/inner-module-declared? - the-struct_0))) - (let ((app_5 - (read-config/inner-coerce - the-struct_0))) - (read-config/inner2.1 - readtable31_0 - next-readtable_0 - for-syntax?29_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - (read-config/inner-coerce-key - the-struct_0) - parameter-override58_1 - parameter-cache59_0 - st57_1))))))))))) + (read-config/inner2.1 + readtable31_0 + next-readtable_0 + for-syntax?29_0 + (read-config/inner-source the-struct_0) + (read-config/inner-read-compiled the-struct_0) + (read-config/inner-call-with-root-namespace + the-struct_0) + (read-config/inner-dynamic-require the-struct_0) + (read-config/inner-module-declared? + the-struct_0) + (read-config/inner-coerce the-struct_0) + (read-config/inner-coerce-key the-struct_0) + parameter-override58_1 + parameter-cache59_0 + st57_1))))) (raise-argument-error 'struct-copy "read-config/inner?" - the-struct_0))))) - (let ((app_0 (read-config/outer-line config41_0))) - (let ((app_1 (read-config/outer-col config41_0))) - (let ((app_2 (read-config/outer-pos config41_0))) - (read-config/outer1.1 - inner53_0 - wrap30_0 - app_0 - app_1 - app_2 - (read-config/outer-indentations config41_0) - keep-comment?34_0))))) + the-struct_0)))) + (read-config/outer1.1 + inner53_0 + wrap30_0 + (read-config/outer-line config41_0) + (read-config/outer-col config41_0) + (read-config/outer-pos config41_0) + (read-config/outer-indentations config41_0) + keep-comment?34_0))) (raise-argument-error 'struct-copy "read-config/outer?" @@ -61253,50 +59871,40 @@ (lambda (config_0 line_0 col_0 pos_0) (if (read-config/outer? config_0) (let ((inner63_0 (read-config/outer-inner config_0))) - (let ((app_0 (read-config/outer-wrap config_0))) - (let ((app_1 (read-config/outer-indentations config_0))) - (read-config/outer1.1 - inner63_0 - app_0 - line_0 - col_0 - pos_0 - app_1 - (read-config/outer-keep-comment? config_0))))) + (read-config/outer1.1 + inner63_0 + (read-config/outer-wrap config_0) + line_0 + col_0 + pos_0 + (read-config/outer-indentations config_0) + (read-config/outer-keep-comment? config_0))) (raise-argument-error 'struct-copy "read-config/outer?" config_0)))) (define disable-wrapping (lambda (config_0) (if (read-config/outer? config_0) (let ((inner65_0 (read-config/outer-inner config_0))) - (let ((app_0 (read-config/outer-line config_0))) - (let ((app_1 (read-config/outer-col config_0))) - (let ((app_2 (read-config/outer-pos config_0))) - (let ((app_3 (read-config/outer-indentations config_0))) - (read-config/outer1.1 - inner65_0 - #f - app_0 - app_1 - app_2 - app_3 - (read-config/outer-keep-comment? config_0))))))) + (read-config/outer1.1 + inner65_0 + #f + (read-config/outer-line config_0) + (read-config/outer-col config_0) + (read-config/outer-pos config_0) + (read-config/outer-indentations config_0) + (read-config/outer-keep-comment? config_0))) (raise-argument-error 'struct-copy "read-config/outer?" config_0)))) (define keep-comment (lambda (config_0) (if (read-config/outer? config_0) (let ((inner67_0 (read-config/outer-inner config_0))) - (let ((app_0 (read-config/outer-wrap config_0))) - (let ((app_1 (read-config/outer-line config_0))) - (let ((app_2 (read-config/outer-col config_0))) - (let ((app_3 (read-config/outer-pos config_0))) - (read-config/outer1.1 - inner67_0 - app_0 - app_1 - app_2 - app_3 - (read-config/outer-indentations config_0) - #t)))))) + (read-config/outer1.1 + inner67_0 + (read-config/outer-wrap config_0) + (read-config/outer-line config_0) + (read-config/outer-col config_0) + (read-config/outer-pos config_0) + (read-config/outer-indentations config_0) + #t)) (raise-argument-error 'struct-copy "read-config/outer?" config_0)))) (define discard-comment (lambda (config_0) @@ -61304,100 +59912,58 @@ config_0 (if (read-config/outer? config_0) (let ((inner69_0 (read-config/outer-inner config_0))) - (let ((app_0 (read-config/outer-wrap config_0))) - (let ((app_1 (read-config/outer-line config_0))) - (let ((app_2 (read-config/outer-col config_0))) - (let ((app_3 (read-config/outer-pos config_0))) - (read-config/outer1.1 - inner69_0 - app_0 - app_1 - app_2 - app_3 - (read-config/outer-indentations config_0) - #f)))))) + (read-config/outer1.1 + inner69_0 + (read-config/outer-wrap config_0) + (read-config/outer-line config_0) + (read-config/outer-col config_0) + (read-config/outer-pos config_0) + (read-config/outer-indentations config_0) + #f)) (raise-argument-error 'struct-copy "read-config/outer?" config_0))))) (define next-readtable (lambda (config_0) - (if (let ((app_0 - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))))) - (eq? - app_0 - (begin-unsafe - (read-config/inner-next-readtable - (read-config/outer-inner config_0))))) + (if (eq? + (begin-unsafe + (read-config/inner-readtable (read-config/outer-inner config_0))) + (begin-unsafe + (read-config/inner-next-readtable + (read-config/outer-inner config_0)))) config_0 (if (read-config/outer? config_0) - (let ((inner70_0 - (let ((the-struct_0 (read-config/outer-inner config_0))) + (let ((the-struct_0 (read-config/outer-inner config_0))) + (let ((inner70_0 (if (read-config/inner? the-struct_0) (let ((readtable71_0 (begin-unsafe (read-config/inner-next-readtable (read-config/outer-inner config_0))))) - (let ((app_0 - (read-config/inner-next-readtable the-struct_0))) - (let ((app_1 - (read-config/inner-for-syntax? the-struct_0))) - (let ((app_2 (read-config/inner-source the-struct_0))) - (let ((app_3 - (read-config/inner-read-compiled - the-struct_0))) - (let ((app_4 - (read-config/inner-call-with-root-namespace - the-struct_0))) - (let ((app_5 - (read-config/inner-dynamic-require - the-struct_0))) - (let ((app_6 - (read-config/inner-module-declared? - the-struct_0))) - (let ((app_7 - (read-config/inner-coerce - the-struct_0))) - (let ((app_8 - (read-config/inner-coerce-key - the-struct_0))) - (let ((app_9 - (read-config/inner-parameter-override - the-struct_0))) - (let ((app_10 - (read-config/inner-parameter-cache - the-struct_0))) - (read-config/inner2.1 - readtable71_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (read-config/inner-st - the-struct_0)))))))))))))) + (read-config/inner2.1 + readtable71_0 + (read-config/inner-next-readtable the-struct_0) + (read-config/inner-for-syntax? the-struct_0) + (read-config/inner-source the-struct_0) + (read-config/inner-read-compiled the-struct_0) + (read-config/inner-call-with-root-namespace the-struct_0) + (read-config/inner-dynamic-require the-struct_0) + (read-config/inner-module-declared? the-struct_0) + (read-config/inner-coerce the-struct_0) + (read-config/inner-coerce-key the-struct_0) + (read-config/inner-parameter-override the-struct_0) + (read-config/inner-parameter-cache the-struct_0) + (read-config/inner-st the-struct_0))) (raise-argument-error 'struct-copy "read-config/inner?" - the-struct_0))))) - (let ((app_0 (read-config/outer-wrap config_0))) - (let ((app_1 (read-config/outer-line config_0))) - (let ((app_2 (read-config/outer-col config_0))) - (let ((app_3 (read-config/outer-pos config_0))) - (let ((app_4 (read-config/outer-indentations config_0))) - (read-config/outer1.1 - inner70_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (read-config/outer-keep-comment? config_0)))))))) + the-struct_0)))) + (read-config/outer1.1 + inner70_0 + (read-config/outer-wrap config_0) + (read-config/outer-line config_0) + (read-config/outer-col config_0) + (read-config/outer-pos config_0) + (read-config/outer-indentations config_0) + (read-config/outer-keep-comment? config_0)))) (raise-argument-error 'struct-copy "read-config/outer?" config_0))))) (define coerce (lambda (val_0 in_0 config_0) @@ -61471,21 +60037,21 @@ (begin-unsafe (read-config/inner-parameter-cache (read-config/outer-inner config_0))))) - (let ((v_0 - (let ((app_0 - (begin-unsafe - (read-config/inner-parameter-override - (read-config/outer-inner config_0))))) - (hash-ref app_0 param_0 (hash-ref cache_0 param_0 unknown))))) - (if (eq? v_0 unknown) - (let ((v_1 (|#%app| param_0))) - (begin (hash-set! cache_0 param_0 v_1) v_1)) - v_0))))) + (let ((app_0 + (begin-unsafe + (read-config/inner-parameter-override + (read-config/outer-inner config_0))))) + (let ((v_0 + (hash-ref app_0 param_0 (hash-ref cache_0 param_0 unknown)))) + (if (eq? v_0 unknown) + (let ((v_1 (|#%app| param_0))) + (begin (hash-set! cache_0 param_0 v_1) v_1)) + v_0)))))) (define override-parameter (lambda (param_0 config_0 v_0) (if (read-config/outer? config_0) - (let ((inner1_0 - (let ((the-struct_0 (read-config/outer-inner config_0))) + (let ((the-struct_0 (read-config/outer-inner config_0))) + (let ((inner1_0 (if (read-config/inner? the-struct_0) (let ((parameter-override2_0 (hash-set @@ -61494,65 +60060,32 @@ (read-config/outer-inner config_0))) param_0 v_0))) - (let ((app_0 (read-config/inner-readtable the-struct_0))) - (let ((app_1 - (read-config/inner-next-readtable the-struct_0))) - (let ((app_2 - (read-config/inner-for-syntax? the-struct_0))) - (let ((app_3 (read-config/inner-source the-struct_0))) - (let ((app_4 - (read-config/inner-read-compiled - the-struct_0))) - (let ((app_5 - (read-config/inner-call-with-root-namespace - the-struct_0))) - (let ((app_6 - (read-config/inner-dynamic-require - the-struct_0))) - (let ((app_7 - (read-config/inner-module-declared? - the-struct_0))) - (let ((app_8 - (read-config/inner-coerce - the-struct_0))) - (let ((app_9 - (read-config/inner-coerce-key - the-struct_0))) - (let ((app_10 - (read-config/inner-parameter-cache - the-struct_0))) - (read-config/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - parameter-override2_0 - app_10 - (read-config/inner-st - the-struct_0)))))))))))))) + (read-config/inner2.1 + (read-config/inner-readtable the-struct_0) + (read-config/inner-next-readtable the-struct_0) + (read-config/inner-for-syntax? the-struct_0) + (read-config/inner-source the-struct_0) + (read-config/inner-read-compiled the-struct_0) + (read-config/inner-call-with-root-namespace the-struct_0) + (read-config/inner-dynamic-require the-struct_0) + (read-config/inner-module-declared? the-struct_0) + (read-config/inner-coerce the-struct_0) + (read-config/inner-coerce-key the-struct_0) + parameter-override2_0 + (read-config/inner-parameter-cache the-struct_0) + (read-config/inner-st the-struct_0))) (raise-argument-error 'struct-copy "read-config/inner?" - the-struct_0))))) - (let ((app_0 (read-config/outer-wrap config_0))) - (let ((app_1 (read-config/outer-line config_0))) - (let ((app_2 (read-config/outer-col config_0))) - (let ((app_3 (read-config/outer-pos config_0))) - (let ((app_4 (read-config/outer-indentations config_0))) - (read-config/outer1.1 - inner1_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (read-config/outer-keep-comment? config_0)))))))) + the-struct_0)))) + (read-config/outer1.1 + inner1_0 + (read-config/outer-wrap config_0) + (read-config/outer-line config_0) + (read-config/outer-col config_0) + (read-config/outer-pos config_0) + (read-config/outer-indentations config_0) + (read-config/outer-keep-comment? config_0)))) (raise-argument-error 'struct-copy "read-config/outer?" config_0)))) (define force-parameters! (lambda (config_0) @@ -62372,19 +60905,20 @@ loop (lambda (backslash?_0) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (if (eof-object? c_0) - (void) - (if (not (char? c_0)) - (loop_0 #f) - (if (char=? c_0 '#\xa) - (if backslash?_0 (loop_0 #f) (void)) - (if (char=? c_0 '#\x5c) (loop_0 #t) (loop_0 #f))))))))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 source_0))) + (if (eof-object? c_0) + (void) + (if (not (char? c_0)) + (loop_0 #f) + (if (char=? c_0 '#\xa) + (if backslash?_0 (loop_0 #f) (void)) + (if (char=? c_0 '#\x5c) + (loop_0 #t) + (loop_0 #f)))))))))))) (loop_0 #f)))) (define readtable-char-delimiter? (lambda (rt_0 c_0 config_0) @@ -62607,8 +61141,10 @@ (lambda (start-pos2_0 a4_0 config5_0) (begin (let ((s_0 - (let ((app_0 (accum-string-str a4_0))) - (substring app_0 start-pos2_0 (accum-string-pos a4_0))))) + (substring + (accum-string-str a4_0) + start-pos2_0 + (accum-string-pos a4_0)))) (begin (begin-unsafe (set-read-config-state-accum-str! @@ -62622,12 +61158,11 @@ (lambda (start-pos7_0 a9_0 config10_0) (begin (let ((bstr_0 - (let ((app_0 (accum-string-str a9_0))) - (string->bytes/latin-1 - app_0 - #f - start-pos7_0 - (accum-string-pos a9_0))))) + (string->bytes/latin-1 + (accum-string-str a9_0) + #f + start-pos7_0 + (accum-string-pos a9_0)))) (begin (begin-unsafe (set-read-config-state-accum-str! @@ -63084,27 +61619,15 @@ seq-config16_0))))) (let ((inner19_0 (read-config/outer-inner elem-config_0))) - (let ((indentations18_1 indentations18_0)) - (let ((app_0 - (read-config/outer-wrap elem-config_0))) - (let ((app_1 - (read-config/outer-line - elem-config_0))) - (let ((app_2 - (read-config/outer-col - elem-config_0))) - (let ((app_3 - (read-config/outer-pos - elem-config_0))) - (read-config/outer1.1 - inner19_0 - app_0 - app_1 - app_2 - app_3 - indentations18_1 - (read-config/outer-keep-comment? - elem-config_0))))))))) + (read-config/outer1.1 + inner19_0 + (read-config/outer-wrap elem-config_0) + (read-config/outer-line elem-config_0) + (read-config/outer-col elem-config_0) + (read-config/outer-pos elem-config_0) + indentations18_0 + (read-config/outer-keep-comment? + elem-config_0)))) (raise-argument-error 'struct-copy "read-config/outer?" @@ -63184,12 +61707,12 @@ (if (check-parameter 1/read-accept-dot config_0) - (let ((c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c_1 (let ((c_1 (peek-char-or-special in15_0 @@ -63201,15 +61724,15 @@ 'special) (special1.1 'special) - c_1))))) - (begin-unsafe - (readtable-char-delimiter? + c_1)))) (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner - seq-config16_0))) - c_1 - seq-config16_0))) + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner + seq-config16_0))) + c_1 + seq-config16_0)))) #f) #f) #f) @@ -63285,12 +61808,12 @@ (if (check-parameter 1/read-accept-infix-dot config_0) - (let ((c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c_1 (let ((c_1 (peek-char-or-special in15_0 @@ -63302,15 +61825,15 @@ 'special) (special1.1 'special) - c_1))))) - (begin-unsafe - (readtable-char-delimiter? + c_1)))) (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner - seq-config16_0))) - c_1 - seq-config16_0))) + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner + seq-config16_0))) + c_1 + seq-config16_0)))) #f) #f) #f) @@ -63472,55 +61995,56 @@ config11_0 accum-str9_0) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config11_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config11_0))))) + (let ((c_0 (let ((c_0 (peek-char-or-special in10_0 0 'special source_0))) - (if (eq? c_0 'special) (special1.1 'special) c_0))))) - (if (digit? c_0 base1_0) - (begin - (begin-unsafe (begin (read-char in10_0) (void))) - (if accum-str9_0 (accum-string-add! accum-str9_0 c_0) (void)) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (v_0 max-count_0) - (begin - (if (zero? max-count_0) - v_0 - (let ((c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config11_0))))) - (let ((c_1 - (peek-char-or-special - in10_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (digit? c_1 base1_0) - (begin - (begin-unsafe (begin (read-char in10_0) (void))) - (if accum-str9_0 - (accum-string-add! accum-str9_0 c_1) - (void)) - (let ((app_0 - (let ((app_0 (digit->number c_1))) - (+ app_0 (* v_0 base1_0))))) - (loop_0 app_0 (sub1 max-count_0)))) - v_0)))))))) - (let ((app_0 - (let ((app_0 (digit->number c_0))) - (+ app_0 (* init3_0 base1_0))))) - (loop_0 app_0 (sub1 max-count2_0))))) - (if zero-digits-result4_0 zero-digits-result4_0 c_0))))))) + (if (eq? c_0 'special) (special1.1 'special) c_0)))) + (if (digit? c_0 base1_0) + (begin + (begin-unsafe (begin (read-char in10_0) (void))) + (if accum-str9_0 (accum-string-add! accum-str9_0 c_0) (void)) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (v_0 max-count_0) + (begin + (if (zero? max-count_0) + v_0 + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config11_0))))) + (let ((c_1 + (let ((c_1 + (peek-char-or-special + in10_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (digit? c_1 base1_0) + (begin + (begin-unsafe + (begin (read-char in10_0) (void))) + (if accum-str9_0 + (accum-string-add! accum-str9_0 c_1) + (void)) + (let ((app_0 + (let ((app_0 (digit->number c_1))) + (+ app_0 (* v_0 base1_0))))) + (loop_0 app_0 (sub1 max-count_0)))) + v_0))))))))) + (let ((app_0 + (let ((app_0 (digit->number c_0))) + (+ app_0 (* init3_0 base1_0))))) + (loop_0 app_0 (sub1 max-count2_0))))) + (if zero-digits-result4_0 zero-digits-result4_0 c_0)))))))) (define digit? (lambda (c_0 base_0) (if (not (char? c_0)) @@ -63786,14 +62310,12 @@ (if (parse-state? state_0) (let ((exactness56_0 (parse-state-other-exactness state_0))) (let ((other-exactness57_0 (parse-state-exactness state_0))) - (let ((exactness56_1 exactness56_0)) - (let ((app_0 (parse-state-convert-mode state_0))) - (parse-state6.1 - exactness56_1 - app_0 - (parse-state-can-single? state_0) - fst_0 - other-exactness57_0))))) + (parse-state6.1 + exactness56_0 + (parse-state-convert-mode state_0) + (parse-state-can-single? state_0) + fst_0 + other-exactness57_0))) (raise-argument-error 'struct-copy "parse-state?" state_0)))) (define state-first-half (lambda (state_0) @@ -63957,10 +62479,7 @@ #f) (if (lazy-expt? n_0) (let ((app_0 (lazy-expt-n n_0))) - (* - app_0 - (let ((app_1 (lazy-expt-radix n_0))) - (expt app_1 (lazy-expt-exp n_0))))) + (* app_0 (expt (lazy-expt-radix n_0) (lazy-expt-exp n_0)))) n_0))))) (define force-lazy-inexact (let ((force-lazy-inexact_0 @@ -64137,8 +62656,8 @@ (force-lazy-exact n19_0 state21_0 s20_0)))))))) (if (polar-prefix? fst_0) (let ((pos_0 (polar-prefix-start fst_0))) - (let ((m_0 - (let ((temp60_0 (polar-prefix-sgn/z fst_0))) + (let ((temp60_0 (polar-prefix-sgn/z fst_0))) + (let ((m_0 (let ((temp61_0 (polar-prefix-n fst_0))) (let ((temp63_0 (state-first-half state21_0))) (let ((temp64_0 (cons 0 pos_0))) @@ -64150,32 +62669,33 @@ temp60_1 temp61_1 s20_0 - temp63_1)))))))) - (let ((a_0 - (let ((temp68_0 (state-second-half state21_0))) - (let ((temp69_0 (cons pos_0 (string-length s20_0)))) - (let ((temp68_1 temp68_0)) - (finish.1 - temp69_0 - sgn/z18_0 - n19_0 - s20_0 - temp68_1)))))) - (if (extflonum? m_0) - (bad-extflonum-for-complex m_0 s20_0 state21_0) - (if (extflonum? a_0) - (bad-extflonum-for-complex a_0 s20_0 state21_0) - (if (let ((or-part_0 (not m_0))) - (if or-part_0 or-part_0 (string? m_0))) - m_0 - (if (let ((or-part_0 (not a_0))) - (if or-part_0 or-part_0 (string? a_0))) - a_0 - (let ((cn_0 (make-polar m_0 a_0))) - (let ((tmp_0 (parse-state-exactness state21_0))) - (if (eq? tmp_0 'exact) - (inexact->exact cn_0) - cn_0)))))))))) + temp63_1))))))) + (let ((a_0 + (let ((temp68_0 (state-second-half state21_0))) + (let ((temp69_0 + (cons pos_0 (string-length s20_0)))) + (let ((temp68_1 temp68_0)) + (finish.1 + temp69_0 + sgn/z18_0 + n19_0 + s20_0 + temp68_1)))))) + (if (extflonum? m_0) + (bad-extflonum-for-complex m_0 s20_0 state21_0) + (if (extflonum? a_0) + (bad-extflonum-for-complex a_0 s20_0 state21_0) + (if (let ((or-part_0 (not m_0))) + (if or-part_0 or-part_0 (string? m_0))) + m_0 + (if (let ((or-part_0 (not a_0))) + (if or-part_0 or-part_0 (string? a_0))) + a_0 + (let ((cn_0 (make-polar m_0 a_0))) + (let ((tmp_0 (parse-state-exactness state21_0))) + (if (eq? tmp_0 'exact) + (inexact->exact cn_0) + cn_0))))))))))) (if fst_0 (if (eq? (state->convert-mode state21_0) 'must-read) (format "missing `i` for complex number in `~.a`" s20_0) @@ -64191,14 +62711,13 @@ v_0 (if (extflonum? v_0) (bad-extflonum-for-complex v_0 s_0 state_0) - (let ((zero_0 - (let ((tmp_0 (parse-state-other-exactness state_0))) - (if (eq? tmp_0 'inexact) 0.0 0)))) - (make-rectangular zero_0 v_0))))) + (let ((tmp_0 (parse-state-other-exactness state_0))) + (let ((zero_0 (if (eq? tmp_0 'inexact) 0.0 0))) + (make-rectangular zero_0 v_0)))))) (if (if (rect-prefix? fst_0) (fx= start_0 end_0) #f) (let ((pos_0 (rect-prefix-start fst_0))) - (let ((r_0 - (let ((temp74_0 (rect-prefix-sgn/z fst_0))) + (let ((temp74_0 (rect-prefix-sgn/z fst_0))) + (let ((r_0 (let ((temp75_0 (rect-prefix-n fst_0))) (let ((temp77_0 (state-first-half state_0))) (let ((temp78_0 (cons 0 pos_0))) @@ -64210,23 +62729,23 @@ temp74_1 temp75_1 s_0 - temp77_1)))))))) - (let ((i_0 - (let ((temp82_0 (state-second-half state_0))) - (let ((temp83_0 (cons pos_0 (string-length s_0)))) - (let ((temp82_1 temp82_0)) - (finish.1 temp83_0 sgn/z_0 n_0 s_0 temp82_1)))))) - (if (extflonum? r_0) - (bad-extflonum-for-complex r_0 s_0 state_0) - (if (extflonum? i_0) - (bad-extflonum-for-complex r_0 i_0 state_0) - (if (let ((or-part_0 (not r_0))) - (if or-part_0 or-part_0 (string? r_0))) - r_0 - (if (let ((or-part_0 (not i_0))) - (if or-part_0 or-part_0 (string? i_0))) - i_0 - (make-rectangular r_0 i_0)))))))) + temp77_1))))))) + (let ((i_0 + (let ((temp82_0 (state-second-half state_0))) + (let ((temp83_0 (cons pos_0 (string-length s_0)))) + (let ((temp82_1 temp82_0)) + (finish.1 temp83_0 sgn/z_0 n_0 s_0 temp82_1)))))) + (if (extflonum? r_0) + (bad-extflonum-for-complex r_0 s_0 state_0) + (if (extflonum? i_0) + (bad-extflonum-for-complex r_0 i_0 state_0) + (if (let ((or-part_0 (not r_0))) + (if or-part_0 or-part_0 (string? r_0))) + r_0 + (if (let ((or-part_0 (not i_0))) + (if or-part_0 or-part_0 (string? i_0))) + i_0 + (make-rectangular r_0 i_0))))))))) (bad-misplaced "i" s_0 state_0)))))) (define set-exactness.1 (|#%name| @@ -64261,15 +62780,12 @@ (if (eq? exactness_0 result-exactness_0) state25_0 (if (parse-state? state25_0) - (let ((app_0 (parse-state-convert-mode state25_0))) - (let ((app_1 (parse-state-can-single? state25_0))) - (let ((app_2 (parse-state-fst state25_0))) - (parse-state6.1 - result-exactness_0 - app_0 - app_1 - app_2 - (parse-state-other-exactness state25_0))))) + (parse-state6.1 + result-exactness_0 + (parse-state-convert-mode state25_0) + (parse-state-can-single? state25_0) + (parse-state-fst state25_0) + (parse-state-other-exactness state25_0)) (raise-argument-error 'struct-copy "parse-state?" @@ -64398,20 +62914,21 @@ (format "no digits") #f) (if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f)) - (read-integer - 1 - c_0 - s35_0 - (fx+ 1 start36_0) - end37_0 - radix38_0 - (begin-unsafe - (parse-state6.1 - exactness39_0 - convert-mode40_0 - (eq? single-mode41_0 'single) - #f - exactness39_0))) + (let ((app_0 (fx+ 1 start36_0))) + (read-integer + 1 + c_0 + s35_0 + app_0 + end37_0 + radix38_0 + (begin-unsafe + (parse-state6.1 + exactness39_0 + convert-mode40_0 + (eq? single-mode41_0 'single) + #f + exactness39_0)))) (if (let ((or-part_0 (eqv? c_0 '#\x23))) (if or-part_0 or-part_0 #f)) (let ((next_0 (fx+ 1 start36_0))) @@ -64553,25 +63070,11 @@ #f)))))) (if (let ((or-part_0 (eqv? c_0 '#\x2b))) (if or-part_0 or-part_0 #f)) - (read-signed - 1 - s35_0 - (fx+ 1 start36_0) - end37_0 - radix38_0 - (begin-unsafe - (parse-state6.1 - exactness39_0 - convert-mode40_0 - (eq? single-mode41_0 'single) - '+/- - exactness39_0))) - (if (let ((or-part_0 (eqv? c_0 '#\x2d))) - (if or-part_0 or-part_0 #f)) + (let ((app_0 (fx+ 1 start36_0))) (read-signed - -1 + 1 s35_0 - (fx+ 1 start36_0) + app_0 end37_0 radix38_0 (begin-unsafe @@ -64580,7 +63083,23 @@ convert-mode40_0 (eq? single-mode41_0 'single) '+/- - exactness39_0))) + exactness39_0)))) + (if (let ((or-part_0 (eqv? c_0 '#\x2d))) + (if or-part_0 or-part_0 #f)) + (let ((app_0 (fx+ 1 start36_0))) + (read-signed + -1 + s35_0 + app_0 + end37_0 + radix38_0 + (begin-unsafe + (parse-state6.1 + exactness39_0 + convert-mode40_0 + (eq? single-mode41_0 'single) + '+/- + exactness39_0)))) (if (let ((or-part_0 (eqv? c_0 '#\x2e))) (if or-part_0 or-part_0 #f)) (let ((app_0 (fx+ 1 start36_0))) @@ -66076,16 +64595,14 @@ #f) #f))) (if c1_0 - (let ((app_0 (begin-unsafe (read-config/outer-line config_0)))) - (let ((app_1 (begin-unsafe (read-config/outer-col config_0)))) - (readtable-apply - c1_0 - init-c5_0 - in6_0 - config_0 - app_0 - app_1 - (begin-unsafe (read-config/outer-pos config_0))))) + (readtable-apply + c1_0 + init-c5_0 + in6_0 + config_0 + (begin-unsafe (read-config/outer-line config_0)) + (begin-unsafe (read-config/outer-col config_0)) + (begin-unsafe (read-config/outer-pos config_0))) (let ((accum-str_0 (accum-string-init! config_0))) (let ((quoted-ever?_0 #f)) (let ((case-sens?_0 @@ -66781,77 +65298,78 @@ temp28_0 (list c2_0))) (void)) - (let ((c3_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (call-with-values - (lambda () - (if (decimal-digit? c3_0) - (read-simple-number in_0 config_0 c3_0) - (values #f "" c3_0))) - (case-lambda - ((vector-len_0 len-str_0 c4_0) - (if (eqv? c4_0 '#\x28) - (read-vector.1 - vector-len_0 - vector-mode_0 - read-one_0 - '#\x28 - '#\x28 - '#\x29 - in_0 - config_0) - (if (eqv? c4_0 '#\x5b) - (if (check-parameter - 1/read-square-bracket-as-paren - config_0) - (read-vector.1 - vector-len_0 - vector-mode_0 - read-one_0 - '#\x5b - '#\x5b - '#\x5d - in_0 - config_0) - (let ((temp48_0 - (format - "~a~a" - dispatch-c_0 - (format "~a~a" c_0 c2_0)))) - (bad-syntax-error.1 '#\x78 in_0 config_0 temp48_0))) - (if (eqv? c4_0 '#\x7b) - (if (check-parameter 1/read-curly-brace-as-paren config_0) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c3_0 (read-char-or-special in_0 special1.1 source_0))) + (call-with-values + (lambda () + (if (decimal-digit? c3_0) + (read-simple-number in_0 config_0 c3_0) + (values #f "" c3_0))) + (case-lambda + ((vector-len_0 len-str_0 c4_0) + (if (eqv? c4_0 '#\x28) + (read-vector.1 + vector-len_0 + vector-mode_0 + read-one_0 + '#\x28 + '#\x28 + '#\x29 + in_0 + config_0) + (if (eqv? c4_0 '#\x5b) + (if (check-parameter + 1/read-square-bracket-as-paren + config_0) (read-vector.1 vector-len_0 vector-mode_0 read-one_0 - '#\x7b - '#\x7b - '#\x7d + '#\x5b + '#\x5b + '#\x5d in_0 config_0) - (let ((temp59_0 + (let ((temp48_0 (format "~a~a" dispatch-c_0 (format "~a~a" c_0 c2_0)))) - (bad-syntax-error.1 '#\x78 in_0 config_0 temp59_0))) - (let ((temp63_0 - "expected `(`, `[`, or `{` after `#~a~a~a`")) - (reader-error.1 - unsafe-undefined - c4_0 - #f - unsafe-undefined - in_0 - config_0 - temp63_0 - (list c_0 c2_0 len-str_0))))))) - (args (raise-binding-result-arity-error 3 args)))))))))) + (bad-syntax-error.1 '#\x78 in_0 config_0 temp48_0))) + (if (eqv? c4_0 '#\x7b) + (if (check-parameter + 1/read-curly-brace-as-paren + config_0) + (read-vector.1 + vector-len_0 + vector-mode_0 + read-one_0 + '#\x7b + '#\x7b + '#\x7d + in_0 + config_0) + (let ((temp59_0 + (format + "~a~a" + dispatch-c_0 + (format "~a~a" c_0 c2_0)))) + (bad-syntax-error.1 '#\x78 in_0 config_0 temp59_0))) + (let ((temp63_0 + "expected `(`, `[`, or `{` after `#~a~a~a`")) + (reader-error.1 + unsafe-undefined + c4_0 + #f + unsafe-undefined + in_0 + config_0 + temp63_0 + (list c_0 c2_0 len-str_0))))))) + (args (raise-binding-result-arity-error 3 args))))))))))) (define read-simple-number (lambda (in_0 config_0 init-c_0) (let ((accum-str_0 (accum-string-init! config_0))) @@ -66878,75 +65396,61 @@ (read-char-or-special in_0 special1.1 source_0)))))))))) (define read-struct (lambda (read-one_0 dispatch-c_0 in_0 config_0) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (let ((ec_0 (effective-char c_0 config_0))) - (let ((seq_0 - (if (eqv? ec_0 '#\x28) - (read-struct-sequence - read-one_0 - c_0 - '#\x28 - '#\x29 - in_0 - config_0) - (if (eqv? ec_0 '#\x5b) - (if (check-parameter - 1/read-square-bracket-as-paren - config_0) - (read-struct-sequence - read-one_0 - c_0 - '#\x5b - '#\x5d - in_0 - config_0) - (let ((temp3_0 (format "~as~a" dispatch-c_0 c_0))) - (bad-syntax-error.1 '#\x78 in_0 config_0 temp3_0))) - (if (eqv? ec_0 '#\x7b) - (if (check-parameter 1/read-curly-brace-as-paren config_0) + (let ((source_0 + (begin-unsafe + (read-config/inner-source (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 source_0))) + (let ((ec_0 (effective-char c_0 config_0))) + (let ((seq_0 + (if (eqv? ec_0 '#\x28) + (read-struct-sequence + read-one_0 + c_0 + '#\x28 + '#\x29 + in_0 + config_0) + (if (eqv? ec_0 '#\x5b) + (if (check-parameter + 1/read-square-bracket-as-paren + config_0) (read-struct-sequence read-one_0 c_0 - '#\x7b - '#\x7d + '#\x5b + '#\x5d in_0 config_0) - (let ((temp6_0 (format "~as~a" dispatch-c_0 c_0))) - (bad-syntax-error.1 '#\x78 in_0 config_0 temp6_0))) - (let ((temp9_0 "expected ~a after `~as`")) - (let ((temp10_0 (all-openers-str config_0))) - (let ((temp9_1 temp9_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp9_1 - (list temp10_0 dispatch-c_0)))))))))) - (begin - (if (null? seq_0) - (let ((temp14_0 "missing structure description in `~as` form")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp14_0 - (list dispatch-c_0))) - (void)) + (let ((temp3_0 (format "~as~a" dispatch-c_0 c_0))) + (bad-syntax-error.1 '#\x78 in_0 config_0 temp3_0))) + (if (eqv? ec_0 '#\x7b) + (if (check-parameter + 1/read-curly-brace-as-paren + config_0) + (read-struct-sequence + read-one_0 + c_0 + '#\x7b + '#\x7d + in_0 + config_0) + (let ((temp6_0 (format "~as~a" dispatch-c_0 c_0))) + (bad-syntax-error.1 '#\x78 in_0 config_0 temp6_0))) + (let ((temp9_0 "expected ~a after `~as`")) + (let ((temp10_0 (all-openers-str config_0))) + (let ((temp9_1 temp9_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp9_1 + (list temp10_0 dispatch-c_0)))))))))) (begin - (if (prefab-key? (car seq_0)) - (void) - (let ((temp18_0 "invalid structure description in `~as` form")) + (if (null? seq_0) + (let ((temp14_0 "missing structure description in `~as` form")) (reader-error.1 unsafe-undefined '#\x78 @@ -66954,55 +65458,52 @@ unsafe-undefined in_0 config_0 - temp18_0 - (list dispatch-c_0)))) - (let ((with-handlers-handler21_0 - (|#%name| - with-handlers-handler21 - (lambda (exn_0) (begin #f))))) - (let ((st_0 - (let ((bpz_0 - (continuation-mark-set-first - #f - break-enabled-key))) - (call-handled-body - bpz_0 - (lambda (e_0) - (select-handler/no-breaks - e_0 - bpz_0 - (list - (cons exn:fail? with-handlers-handler21_0)))) - (lambda () - (let ((app_0 (car seq_0))) - (prefab-key->struct-type - app_0 - (length (cdr seq_0))))))))) - (begin - (if st_0 - (void) - (let ((temp24_0 - (string-append - "mismatch between structure description" - " and number of provided field values in `~as` form"))) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp24_0 - (list dispatch-c_0)))) - (if (begin-unsafe - (read-config/inner-for-syntax? - (read-config/outer-inner config_0))) - (if (let ((k_0 (car seq_0))) - (begin-unsafe - (prefab-key-all-fields-immutable? k_0))) + temp14_0 + (list dispatch-c_0))) + (void)) + (begin + (if (prefab-key? (car seq_0)) + (void) + (let ((temp18_0 + "invalid structure description in `~as` form")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp18_0 + (list dispatch-c_0)))) + (let ((with-handlers-handler21_0 + (|#%name| + with-handlers-handler21 + (lambda (exn_0) (begin #f))))) + (let ((st_0 + (let ((bpz_0 + (continuation-mark-set-first + #f + break-enabled-key))) + (call-handled-body + bpz_0 + (lambda (e_0) + (select-handler/no-breaks + e_0 + bpz_0 + (list + (cons exn:fail? with-handlers-handler21_0)))) + (lambda () + (let ((app_0 (car seq_0))) + (prefab-key->struct-type + app_0 + (length (cdr seq_0))))))))) + (begin + (if st_0 (void) - (let ((temp28_0 - "cannot read mutable `~as` form as syntax")) + (let ((temp24_0 + (string-append + "mismatch between structure description" + " and number of provided field values in `~as` form"))) (reader-error.1 unsafe-undefined '#\x78 @@ -67010,14 +65511,32 @@ unsafe-undefined in_0 config_0 - temp28_0 + temp24_0 (list dispatch-c_0)))) - (void)) - (wrap - (apply make-prefab-struct seq_0) - in_0 - config_0 - ec_0))))))))))) + (if (begin-unsafe + (read-config/inner-for-syntax? + (read-config/outer-inner config_0))) + (if (let ((k_0 (car seq_0))) + (begin-unsafe + (prefab-key-all-fields-immutable? k_0))) + (void) + (let ((temp28_0 + "cannot read mutable `~as` form as syntax")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp28_0 + (list dispatch-c_0)))) + (void)) + (wrap + (apply make-prefab-struct seq_0) + in_0 + config_0 + ec_0)))))))))))) (define read-struct-sequence (lambda (read-one_0 opener-c_0 opener_0 closer_0 in_0 config_0) (let ((temp36_0 @@ -67064,31 +65583,13 @@ dispatch-c_0 (accum-string-get!.1 0 accum-str_0 config_0) c_0)))))) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (let ((ec_0 (effective-char c_0 config_0))) - (if (eqv? ec_0 '#\x28) - (begin - (begin-unsafe - (set-read-config-state-accum-str! - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner config_0))) - accum-str_0)) - (read-vector.1 - v_0 - 'any - read-one_0 - c_0 - '#\x28 - '#\x29 - in_0 - config_0)) - (if (eqv? ec_0 '#\x5b) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 source_0))) + (let ((ec_0 (effective-char c_0 config_0))) + (if (eqv? ec_0 '#\x28) (begin (begin-unsafe (set-read-config-state-accum-str! @@ -67096,25 +65597,16 @@ (read-config/inner-st (read-config/outer-inner config_0))) accum-str_0)) - (if (check-parameter - 1/read-square-bracket-as-paren - config_0) - (read-vector.1 - v_0 - 'any - read-one_0 - c_0 - '#\x5b - '#\x5d - in_0 - config_0) - (let ((temp26_0 (get-accum_0 (get-accum_0 c_0)))) - (bad-syntax-error.1 - '#\x78 - in_0 - config_0 - temp26_0)))) - (if (eqv? ec_0 '#\x7b) + (read-vector.1 + v_0 + 'any + read-one_0 + c_0 + '#\x28 + '#\x29 + in_0 + config_0)) + (if (eqv? ec_0 '#\x5b) (begin (begin-unsafe (set-read-config-state-accum-str! @@ -67123,197 +65615,227 @@ (read-config/outer-inner config_0))) accum-str_0)) (if (check-parameter - 1/read-curly-brace-as-paren + 1/read-square-bracket-as-paren config_0) (read-vector.1 v_0 'any read-one_0 c_0 - '#\x7b - '#\x7d + '#\x5b + '#\x5d in_0 config_0) - (let ((temp36_0 + (let ((temp26_0 (get-accum_0 (get-accum_0 c_0)))) (bad-syntax-error.1 '#\x78 in_0 config_0 - temp36_0)))) - (if (if (eqv? c_0 '#\x3d) #t (eqv? c_0 '#\x23)) + temp26_0)))) + (if (eqv? ec_0 '#\x7b) (begin - (if (let ((or-part_0 - (begin-unsafe - (read-config/inner-for-syntax? - (read-config/outer-inner - config_0))))) - (if or-part_0 - or-part_0 - (not - (check-parameter - 1/read-accept-graph - config_0)))) - (let ((temp39_0 "`#...~a` forms not ~a")) - (let ((temp41_0 - (if (begin-unsafe - (read-config/inner-for-syntax? - (read-config/outer-inner - config_0))) - "allowed in `read-syntax` mode" - "enabled"))) - (let ((temp39_1 temp39_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp39_1 - (list c_0 temp41_0))))) - (void)) - (if (<= - (begin-unsafe - (accum-string-pos accum-str_0)) - 8) - (void) - (let ((temp44_0 - "graph ID too long in `~a~a~a`")) - (let ((temp46_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp44_1 temp44_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp44_1 - (list dispatch-c_0 temp46_0 c_0)))))) - (if (eqv? c_0 '#\x3d) - (let ((ph_0 (make-placeholder 'placeholder))) - (let ((ht_0 (get-graph-hash config_0))) - (begin - (if (hash-ref ht_0 v_0 #f) - (let ((temp52_0 - "multiple `~a~a~a` tags")) - (let ((temp54_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp52_1 temp52_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp52_1 - (list - dispatch-c_0 - temp54_0 - c_0))))) - (void)) - (begin - (hash-set! ht_0 v_0 ph_0) - (let ((result-v_0 - (|#%app| - read-one_0 - #f - in_0 - (next-readtable config_0)))) - (begin - (if (eof-object? result-v_0) - (let ((temp61_0 - "expected an element for graph after `~a~a~a`, found end-of-file")) - (let ((temp63_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp61_1 temp61_0)) - (reader-error.1 - unsafe-undefined - result-v_0 - #f - unsafe-undefined - in_0 - config_0 - temp61_1 - (list - dispatch-c_0 - temp63_0 - c_0))))) - (void)) - (begin-unsafe - (set-read-config-state-accum-str! - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner - config_0))) - accum-str_0)) - (placeholder-set! ph_0 result-v_0) - ph_0)))))) - (if (eqv? c_0 '#\x23) - (begin0 - (hash-ref - (let ((or-part_0 - (read-config-state-graph - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner - config_0)))))) - (if or-part_0 or-part_0 hash2725)) - v_0 - (lambda () - (let ((temp69_0 - "no preceding `~a~a=` for `~a~a~a`")) - (let ((temp73_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp69_1 temp69_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp69_1 - (list - dispatch-c_0 - v_0 - dispatch-c_0 - temp73_0 - c_0))))))) - (begin-unsafe - (set-read-config-state-accum-str! - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner config_0))) - accum-str_0))) - (void)))) - (let ((temp80_0 "bad syntax `~a`")) - (let ((temp81_0 (get-accum_0 c_0))) - (let ((temp80_1 temp80_0)) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined + (begin-unsafe + (set-read-config-state-accum-str! + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner config_0))) + accum-str_0)) + (if (check-parameter + 1/read-curly-brace-as-paren + config_0) + (read-vector.1 + v_0 + 'any + read-one_0 + c_0 + '#\x7b + '#\x7d + in_0 + config_0) + (let ((temp36_0 + (get-accum_0 (get-accum_0 c_0)))) + (bad-syntax-error.1 + '#\x78 in_0 config_0 - temp80_1 - (list temp81_0))))))))))))) + temp36_0)))) + (if (if (eqv? c_0 '#\x3d) #t (eqv? c_0 '#\x23)) + (begin + (if (let ((or-part_0 + (begin-unsafe + (read-config/inner-for-syntax? + (read-config/outer-inner + config_0))))) + (if or-part_0 + or-part_0 + (not + (check-parameter + 1/read-accept-graph + config_0)))) + (let ((temp39_0 "`#...~a` forms not ~a")) + (let ((temp41_0 + (if (begin-unsafe + (read-config/inner-for-syntax? + (read-config/outer-inner + config_0))) + "allowed in `read-syntax` mode" + "enabled"))) + (let ((temp39_1 temp39_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp39_1 + (list c_0 temp41_0))))) + (void)) + (if (<= + (begin-unsafe + (accum-string-pos accum-str_0)) + 8) + (void) + (let ((temp44_0 + "graph ID too long in `~a~a~a`")) + (let ((temp46_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp44_1 temp44_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp44_1 + (list dispatch-c_0 temp46_0 c_0)))))) + (if (eqv? c_0 '#\x3d) + (let ((ph_0 + (make-placeholder 'placeholder))) + (let ((ht_0 (get-graph-hash config_0))) + (begin + (if (hash-ref ht_0 v_0 #f) + (let ((temp52_0 + "multiple `~a~a~a` tags")) + (let ((temp54_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp52_1 temp52_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp52_1 + (list + dispatch-c_0 + temp54_0 + c_0))))) + (void)) + (begin + (hash-set! ht_0 v_0 ph_0) + (let ((result-v_0 + (|#%app| + read-one_0 + #f + in_0 + (next-readtable config_0)))) + (begin + (if (eof-object? result-v_0) + (let ((temp61_0 + "expected an element for graph after `~a~a~a`, found end-of-file")) + (let ((temp63_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp61_1 temp61_0)) + (reader-error.1 + unsafe-undefined + result-v_0 + #f + unsafe-undefined + in_0 + config_0 + temp61_1 + (list + dispatch-c_0 + temp63_0 + c_0))))) + (void)) + (begin-unsafe + (set-read-config-state-accum-str! + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner + config_0))) + accum-str_0)) + (placeholder-set! + ph_0 + result-v_0) + ph_0)))))) + (if (eqv? c_0 '#\x23) + (begin0 + (hash-ref + (let ((or-part_0 + (read-config-state-graph + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner + config_0)))))) + (if or-part_0 or-part_0 hash2725)) + v_0 + (lambda () + (let ((temp69_0 + "no preceding `~a~a=` for `~a~a~a`")) + (let ((temp73_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp69_1 temp69_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp69_1 + (list + dispatch-c_0 + v_0 + dispatch-c_0 + temp73_0 + c_0))))))) + (begin-unsafe + (set-read-config-state-accum-str! + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner config_0))) + accum-str_0))) + (void)))) + (let ((temp80_0 "bad syntax `~a`")) + (let ((temp81_0 (get-accum_0 c_0))) + (let ((temp80_1 temp80_0)) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp80_1 + (list temp81_0)))))))))))))) (args (raise-binding-result-arity-error 3 args)))))))))) (define get-graph-hash (lambda (config_0) @@ -67348,38 +65870,38 @@ get-next! (lambda (expect-c_0 expect-alt-c_0) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 - source_0)))) - (begin - (if (let ((or-part_0 (eqv? c_0 expect-c_0))) - (if or-part_0 - or-part_0 - (eqv? c_0 expect-alt-c_0))) - (void) - (let ((temp4_0 "expected `~a` after `~a`")) - (let ((temp6_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp4_1 temp4_0)) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp4_1 - (list expect-c_0 temp6_0)))))) - (accum-string-add! accum-str_0 c_0)))))))) + source_0))) + (begin + (if (let ((or-part_0 (eqv? c_0 expect-c_0))) + (if or-part_0 + or-part_0 + (eqv? c_0 expect-alt-c_0))) + (void) + (let ((temp4_0 "expected `~a` after `~a`")) + (let ((temp6_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp4_1 temp4_0)) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp4_1 + (list expect-c_0 temp6_0)))))) + (accum-string-add! accum-str_0 c_0))))))))) (begin (get-next!_0 '#\x61 '#\x41) (begin @@ -67394,97 +65916,51 @@ loop (lambda (mode_0) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 - source_0)))) - (let ((ec_0 (effective-char c_0 config_0))) - (if (eqv? ec_0 '#\x28) - (call-with-values - (lambda () (port-next-location in_0)) - (case-lambda - ((open-end-line_0 - open-end-col_0 - open-end-pos_0) - (let ((read-one-key+value_0 - (make-read-one-key+value - read-one_0 - c_0 - '#\x29 - open-end-pos_0))) - (values - (read-unwrapped-sequence.1 - #f - config_0 - unsafe-undefined - #f - unsafe-undefined - read-one-key+value_0 - c_0 - '#\x28 - '#\x29 - in_0 - config_0) - ec_0 - mode_0))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (if (eqv? ec_0 '#\x5b) - (if (check-parameter - 1/read-square-bracket-as-paren - config_0) - (call-with-values - (lambda () (port-next-location in_0)) - (case-lambda - ((open-end-line_0 - open-end-col_0 - open-end-pos_0) - (let ((read-one-key+value_0 - (make-read-one-key+value - read-one_0 - c_0 - '#\x5d - open-end-pos_0))) - (values - (read-unwrapped-sequence.1 - #f - config_0 - unsafe-undefined - #f - unsafe-undefined - read-one-key+value_0 - c_0 - '#\x5b - '#\x5d - in_0 - config_0) - ec_0 - mode_0))) - (args - (raise-binding-result-arity-error - 3 - args)))) - (let ((temp27_0 "illegal use of `~a`")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp27_0 - (list c_0)))) - (if (eqv? ec_0 '#\x7b) + source_0))) + (let ((ec_0 (effective-char c_0 config_0))) + (if (eqv? ec_0 '#\x28) + (call-with-values + (lambda () (port-next-location in_0)) + (case-lambda + ((open-end-line_0 + open-end-col_0 + open-end-pos_0) + (let ((read-one-key+value_0 + (make-read-one-key+value + read-one_0 + c_0 + '#\x29 + open-end-pos_0))) + (values + (read-unwrapped-sequence.1 + #f + config_0 + unsafe-undefined + #f + unsafe-undefined + read-one-key+value_0 + c_0 + '#\x28 + '#\x29 + in_0 + config_0) + ec_0 + mode_0))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (if (eqv? ec_0 '#\x5b) (if (check-parameter - 1/read-curly-brace-as-paren + 1/read-square-bracket-as-paren config_0) (call-with-values (lambda () (port-next-location in_0)) @@ -67496,7 +65972,7 @@ (make-read-one-key+value read-one_0 c_0 - '#\x7d + '#\x5d open-end-pos_0))) (values (read-unwrapped-sequence.1 @@ -67507,8 +65983,8 @@ unsafe-undefined read-one-key+value_0 c_0 - '#\x7b - '#\x7d + '#\x5b + '#\x5d in_0 config_0) ec_0 @@ -67517,7 +65993,7 @@ (raise-binding-result-arity-error 3 args)))) - (let ((temp39_0 + (let ((temp27_0 "illegal use of `~a`")) (reader-error.1 unsafe-undefined @@ -67526,65 +66002,114 @@ unsafe-undefined in_0 config_0 - temp39_0 + temp27_0 (list c_0)))) - (if (if (eqv? ec_0 '#\x65) - #t - (eqv? ec_0 '#\x45)) - (begin - (accum-string-add! accum-str_0 c_0) - (get-next!_0 '#\x71 '#\x51) - (loop_0 'eq)) - (if (if (eqv? ec_0 '#\x76) + (if (eqv? ec_0 '#\x7b) + (if (check-parameter + 1/read-curly-brace-as-paren + config_0) + (call-with-values + (lambda () + (port-next-location in_0)) + (case-lambda + ((open-end-line_0 + open-end-col_0 + open-end-pos_0) + (let ((read-one-key+value_0 + (make-read-one-key+value + read-one_0 + c_0 + '#\x7d + open-end-pos_0))) + (values + (read-unwrapped-sequence.1 + #f + config_0 + unsafe-undefined + #f + unsafe-undefined + read-one-key+value_0 + c_0 + '#\x7b + '#\x7d + in_0 + config_0) + ec_0 + mode_0))) + (args + (raise-binding-result-arity-error + 3 + args)))) + (let ((temp39_0 + "illegal use of `~a`")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp39_0 + (list c_0)))) + (if (if (eqv? ec_0 '#\x65) #t - (eqv? ec_0 '#\x56)) + (eqv? ec_0 '#\x45)) (begin (accum-string-add! accum-str_0 c_0) - (if (eq? mode_0 'eq) - (loop_0 'eqv) - (let ((temp43_0 + (get-next!_0 '#\x71 '#\x51) + (loop_0 'eq)) + (if (if (eqv? ec_0 '#\x76) + #t + (eqv? ec_0 '#\x56)) + (begin + (accum-string-add! + accum-str_0 + c_0) + (if (eq? mode_0 'eq) + (loop_0 'eqv) + (let ((temp43_0 + "bad syntax `~a`")) + (let ((temp44_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp43_1 temp43_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp43_1 + (list temp44_0))))))) + (begin + (if (char? c_0) + (accum-string-add! + accum-str_0 + c_0) + (void)) + (let ((temp50_0 "bad syntax `~a`")) - (let ((temp44_0 + (let ((temp51_0 (accum-string-get!.1 0 accum-str_0 config_0))) - (let ((temp43_1 temp43_0)) + (let ((temp50_1 temp50_0)) (reader-error.1 unsafe-undefined - '#\x78 + c_0 #f unsafe-undefined in_0 config_0 - temp43_1 - (list temp44_0))))))) - (begin - (if (char? c_0) - (accum-string-add! - accum-str_0 - c_0) - (void)) - (let ((temp50_0 - "bad syntax `~a`")) - (let ((temp51_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp50_1 temp50_0)) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp50_1 - (list - temp51_0)))))))))))))))))) + temp50_1 + (list + temp51_0))))))))))))))))))) (loop_0 'equal))) (case-lambda ((content_0 opener_0 mode_0) @@ -67740,12 +66265,12 @@ (let ((dot-ec_0 (effective-char dot-c_0 config_0))) (begin (if (if (eqv? dot-ec_0 '#\x2e) - (let ((c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c_1 (let ((c_1 (peek-char-or-special in_0 @@ -67754,14 +66279,15 @@ source_0))) (if (eq? c_1 'special) (special1.1 'special) - c_1))))) - (begin-unsafe - (readtable-char-delimiter? + c_1)))) (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))) - c_1 - config_0))) + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner + config_0))) + c_1 + config_0)))) #f) (void) (let ((temp70_0 @@ -68600,9 +67126,8 @@ (for-loop_0 lst_0)))) (void))) (if (char=? c_0 '#\xa) - (loop_0 - (cdr full-terminator_0) - (list '#\xa)) + (let ((app_0 (cdr full-terminator_0))) + (loop_0 app_0 (list '#\xa))) (begin (accum-string-add! accum-str_0 c_0) (loop_0 @@ -68626,26 +67151,13 @@ (list escaping-c_0 escaped-c_0))))) (define read-character (lambda (in_0 config_0) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (let ((char_0 - (if (eof-object? c_0) - (let ((temp4_0 "expected a character after `#\\`")) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp4_0 - (list))) - (if (not (char? c_0)) - (let ((temp8_0 "found non-character after `#\\`")) + (let ((source_0 + (begin-unsafe + (read-config/inner-source (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 source_0))) + (let ((char_0 + (if (eof-object? c_0) + (let ((temp4_0 "expected a character after `#\\`")) (reader-error.1 unsafe-undefined c_0 @@ -68653,83 +67165,125 @@ unsafe-undefined in_0 config_0 - temp8_0 + temp4_0 (list))) - (if (octal-digit? c_0) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (if (char? c2_0) (octal-digit? c2_0) #f) - (begin - (begin-unsafe (begin (read-char in_0) (void))) - (let ((c3_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special + (if (not (char? c_0)) + (let ((temp8_0 "found non-character after `#\\`")) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp8_0 + (list))) + (if (octal-digit? c_0) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c2_0 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (if (char? c2_0) (octal-digit? c2_0) #f) + (begin + (begin-unsafe (begin (read-char in_0) (void))) + (let ((source_2 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c3_0 + (read-char-or-special + in_0 + special1.1 + source_2))) + (let ((v_0 + (if (if (char? c3_0) + (octal-digit? c3_0) + #f) + (let ((app_0 + (arithmetic-shift + (digit->number c_0) + 6))) + (let ((app_1 + (arithmetic-shift + (digit->number c2_0) + 3))) + (+ + app_0 + app_1 + (digit->number c3_0)))) + #f))) + (begin + (if (if v_0 (<= v_0 255) #f) + (void) + (let ((temp12_0 + "bad character constant `#\\~a~a~a`")) + (let ((temp15_0 + (if (char? c3_0) c3_0 ""))) + (let ((temp12_1 temp12_0)) + (reader-error.1 + unsafe-undefined + c3_0 + #f + unsafe-undefined + in_0 + config_0 + temp12_1 + (list c_0 c2_0 temp15_0)))))) + (integer->char v_0)))))) + c_0))) + (if (let ((or-part_0 (char=? c_0 '#\x75))) + (if or-part_0 or-part_0 (char=? c_0 '#\x55))) + (let ((accum-str_0 (accum-string-init! config_0))) + (let ((v_0 + (let ((temp20_0 (if (char=? c_0 '#\x75) 4 8))) + (read-digits.1 + 16 + 0 + temp20_0 + #f in_0 - special1.1 - source_0)))) - (let ((v_0 - (if (if (char? c3_0) (octal-digit? c3_0) #f) - (let ((app_0 - (arithmetic-shift - (digit->number c_0) - 6))) - (let ((app_1 - (arithmetic-shift - (digit->number c2_0) - 3))) - (+ app_0 app_1 (digit->number c3_0)))) - #f))) - (begin - (if (if v_0 (<= v_0 255) #f) - (void) - (let ((temp12_0 - "bad character constant `#\\~a~a~a`")) - (let ((temp15_0 (if (char? c3_0) c3_0 ""))) - (let ((temp12_1 temp12_0)) - (reader-error.1 - unsafe-undefined - c3_0 - #f - unsafe-undefined - in_0 - config_0 - temp12_1 - (list c_0 c2_0 temp15_0)))))) - (integer->char v_0))))) - c_0)) - (if (let ((or-part_0 (char=? c_0 '#\x75))) - (if or-part_0 or-part_0 (char=? c_0 '#\x55))) - (let ((accum-str_0 (accum-string-init! config_0))) - (let ((v_0 - (let ((temp20_0 (if (char=? c_0 '#\x75) 4 8))) - (read-digits.1 - 16 - 0 - temp20_0 - #f - in_0 - config_0 - accum-str_0)))) - (if (integer? v_0) - (if (if (let ((or-part_0 (< v_0 55296))) - (if or-part_0 or-part_0 (> v_0 57343))) - (<= v_0 1114111) - #f) + config_0 + accum-str_0)))) + (if (integer? v_0) + (if (if (let ((or-part_0 (< v_0 55296))) + (if or-part_0 or-part_0 (> v_0 57343))) + (<= v_0 1114111) + #f) + (begin + (begin-unsafe + (set-read-config-state-accum-str! + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner config_0))) + accum-str_0)) + (integer->char v_0)) + (let ((temp23_0 + "bad character constant `#\\u~a`")) + (let ((temp24_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp23_1 temp23_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp23_1 + (list temp24_0)))))) (begin (begin-unsafe (set-read-config-state-accum-str! @@ -68737,142 +67291,127 @@ (read-config/inner-st (read-config/outer-inner config_0))) accum-str_0)) - (integer->char v_0)) - (let ((temp23_0 - "bad character constant `#\\u~a`")) - (let ((temp24_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp23_1 temp23_0)) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp23_1 - (list temp24_0)))))) - (begin - (begin-unsafe - (set-read-config-state-accum-str! - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner config_0))) - accum-str_0)) - c_0)))) - (if (char-alphabetic? c_0) - (let ((next-c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (if (char? next-c_0) - (char-alphabetic? next-c_0) - #f) - (let ((accum-str_0 (accum-string-init! config_0))) - (begin - (accum-string-add! accum-str_0 c_0) - (begin - (accum-string-add! accum-str_0 next-c_0) + c_0)))) + (if (char-alphabetic? c_0) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((next-c_0 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (if (char? next-c_0) + (char-alphabetic? next-c_0) + #f) + (let ((accum-str_0 + (accum-string-init! config_0))) (begin - (begin-unsafe - (begin (read-char in_0) (void))) + (accum-string-add! accum-str_0 c_0) (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda () - (begin - (let ((next-c_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (if (char? next-c_1) - (char-alphabetic? - next-c_1) - #f) - (begin - (accum-string-add! - accum-str_0 - next-c_1) - (begin-unsafe - (begin - (read-char in_0) - (void))) - (loop_0)) - (void)))))))) - (loop_0)) - (let ((name_0 - (string-foldcase - (accum-string-get!.1 - 0 - accum-str_0 - config_0)))) - (if (if (equal? name_0 "nul") - #t - (equal? name_0 "null")) - '#\x0 - (if (equal? name_0 "backspace") - '#\x8 - (if (equal? name_0 "tab") - '#\x9 - (if (if (equal? name_0 "newline") - #t - (equal? name_0 "linefeed")) - '#\xa - (if (equal? name_0 "vtab") - '#\xb - (if (equal? name_0 "page") - '#\xc - (if (equal? name_0 "return") - '#\xd - (if (equal? + (accum-string-add! accum-str_0 next-c_0) + (begin + (begin-unsafe + (begin (read-char in_0) (void))) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((source_2 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((next-c_1 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_2))) + (if (eq? + c_1 + 'special) + (special1.1 + 'special) + c_1)))) + (if (if (char? next-c_1) + (char-alphabetic? + next-c_1) + #f) + (begin + (accum-string-add! + accum-str_0 + next-c_1) + (begin-unsafe + (begin + (read-char in_0) + (void))) + (loop_0)) + (void))))))))) + (loop_0)) + (let ((name_0 + (string-foldcase + (accum-string-get!.1 + 0 + accum-str_0 + config_0)))) + (if (if (equal? name_0 "nul") + #t + (equal? name_0 "null")) + '#\x0 + (if (equal? name_0 "backspace") + '#\x8 + (if (equal? name_0 "tab") + '#\x9 + (if (if (equal? name_0 - "space") - '#\x20 + "newline") + #t + (equal? + name_0 + "linefeed")) + '#\xa + (if (equal? name_0 "vtab") + '#\xb + (if (equal? name_0 "page") + '#\xc (if (equal? name_0 - "rubout") - '#\x7f - (let ((temp31_0 - "bad character constant `#\\~a`")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp31_0 - (list - name_0)))))))))))))))))) - c_0)) - c_0))))))) - (wrap char_0 in_0 config_0 char_0))))) + "return") + '#\xd + (if (equal? + name_0 + "space") + '#\x20 + (if (equal? + name_0 + "rubout") + '#\x7f + (let ((temp31_0 + "bad character constant `#\\~a`")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp31_0 + (list + name_0)))))))))))))))))) + c_0))) + c_0))))))) + (wrap char_0 in_0 config_0 char_0)))))) (define read-quote (lambda (read-one_0 sym_0 desc_0 c_0 in_0 config_0) (let ((wrapped-sym_0 (wrap sym_0 in_0 config_0 c_0))) @@ -68907,81 +67446,50 @@ loop (lambda (chars_1) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 (let ((c_0 (peek-char-or-special in_0 0 'special source_0))) - (if (eq? c_0 'special) - (special1.1 'special) - c_0))))) - (if (begin-unsafe - (readtable-char-delimiter? - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))) - c_0 - config_0)) - (if (null? chars_1) - (void) - (let ((temp4_0 "bad syntax `#~a`")) - (let ((temp5_0 - (accum-string-get!.1 0 accum-str_0 config_0))) - (let ((temp4_1 temp4_0)) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp4_1 - (list temp5_0)))))) - (if (null? chars_1) - (begin - (accum-string-add! accum-str_0 c_0) - (let ((temp10_0 "bad syntax `#~a`")) - (let ((temp11_0 + (if (eq? c_0 'special) (special1.1 'special) c_0)))) + (if (begin-unsafe + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner config_0))) + c_0 + config_0)) + (if (null? chars_1) + (void) + (let ((temp4_0 "bad syntax `#~a`")) + (let ((temp5_0 (accum-string-get!.1 0 accum-str_0 config_0))) - (let ((temp10_1 temp10_0)) + (let ((temp4_1 temp4_0)) (reader-error.1 unsafe-undefined - '#\x78 + c_0 #f unsafe-undefined in_0 config_0 - temp10_1 - (list temp11_0)))))) - (if (if can-match?_0 (char=? c_0 (car chars_1)) #f) + temp4_1 + (list temp5_0)))))) + (if (null? chars_1) (begin - (begin-unsafe (begin (read-char in_0) (void))) (accum-string-add! accum-str_0 c_0) - (loop_0 (cdr chars_1))) - (begin - (begin-unsafe - (begin - (read-char-or-special - in_0 - special1.1 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0)))) - (void))) - (accum-string-add! accum-str_0 c_0) - (let ((temp16_0 "bad syntax `#~a`")) - (let ((temp17_0 + (let ((temp10_0 "bad syntax `#~a`")) + (let ((temp11_0 (accum-string-get!.1 0 accum-str_0 config_0))) - (let ((temp16_1 temp16_0)) + (let ((temp10_1 temp10_0)) (reader-error.1 unsafe-undefined '#\x78 @@ -68989,8 +67497,40 @@ unsafe-undefined in_0 config_0 - temp16_1 - (list temp17_0))))))))))))))) + temp10_1 + (list temp11_0)))))) + (if (if can-match?_0 (char=? c_0 (car chars_1)) #f) + (begin + (begin-unsafe (begin (read-char in_0) (void))) + (accum-string-add! accum-str_0 c_0) + (loop_0 (cdr chars_1))) + (begin + (begin-unsafe + (begin + (read-char-or-special + in_0 + special1.1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0)))) + (void))) + (accum-string-add! accum-str_0 c_0) + (let ((temp16_0 "bad syntax `#~a`")) + (let ((temp17_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp16_1 temp16_0)) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp16_1 + (list temp17_0)))))))))))))))) (loop_0 chars_0)) (wrap val_0 @@ -69043,94 +67583,93 @@ (args (raise-binding-result-arity-error 3 args))))))) (define read-regexp (lambda (mode-c_0 accum-str_0 in_0 config_0) - (let ((c3_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (let ((no-wrap-config_0 (disable-wrapping config_0))) - (let ((rx_0 - (if (eqv? c3_0 '#\x22) - (begin - (begin-unsafe - (set-read-config-state-accum-str! - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner config_0))) - accum-str_0)) - (let ((str_0 (read-string.1 'string in_0 no-wrap-config_0))) - (catch-and-reraise-as-reader/proc - in_0 - config_0 - (lambda () - (|#%app| - (if (char=? mode-c_0 '#\x72) regexp pregexp) - str_0))))) - (if (eqv? c3_0 '#\x23) + (let ((source_0 + (begin-unsafe + (read-config/inner-source (read-config/outer-inner config_0))))) + (let ((c3_0 (read-char-or-special in_0 special1.1 source_0))) + (let ((no-wrap-config_0 (disable-wrapping config_0))) + (let ((rx_0 + (if (eqv? c3_0 '#\x22) (begin - (accum-string-add! accum-str_0 c3_0) - (let ((c4_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special - in_0 - special1.1 - source_0)))) - (if (eqv? c4_0 '#\x22) - (begin - (begin-unsafe - (set-read-config-state-accum-str! - (begin-unsafe - (read-config/inner-st - (read-config/outer-inner config_0))) - accum-str_0)) - (let ((bstr_0 - (read-string.1 - '|byte string| - in_0 - no-wrap-config_0))) - (catch-and-reraise-as-reader/proc - in_0 - config_0 - (lambda () - (|#%app| - (if (char=? mode-c_0 '#\x72) - byte-regexp - byte-pregexp) - bstr_0))))) - (let ((temp9_0 "expected `\"` after `~a`")) - (let ((temp10_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (let ((temp9_1 temp9_0)) - (reader-error.1 - unsafe-undefined - c4_0 - #f - unsafe-undefined - in_0 - config_0 - temp9_1 - (list temp10_0)))))))) - (let ((temp16_0 "expected `\"` or `#` after `~a`")) - (let ((temp17_0 - (accum-string-get!.1 0 accum-str_0 config_0))) - (let ((temp16_1 temp16_0)) - (reader-error.1 - unsafe-undefined - c3_0 - #f - unsafe-undefined - in_0 - config_0 - temp16_1 - (list temp17_0))))))))) - (wrap rx_0 in_0 config_0 #f)))))) + (begin-unsafe + (set-read-config-state-accum-str! + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner config_0))) + accum-str_0)) + (let ((str_0 + (read-string.1 'string in_0 no-wrap-config_0))) + (catch-and-reraise-as-reader/proc + in_0 + config_0 + (lambda () + (|#%app| + (if (char=? mode-c_0 '#\x72) regexp pregexp) + str_0))))) + (if (eqv? c3_0 '#\x23) + (begin + (accum-string-add! accum-str_0 c3_0) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c4_0 + (read-char-or-special + in_0 + special1.1 + source_1))) + (if (eqv? c4_0 '#\x22) + (begin + (begin-unsafe + (set-read-config-state-accum-str! + (begin-unsafe + (read-config/inner-st + (read-config/outer-inner config_0))) + accum-str_0)) + (let ((bstr_0 + (read-string.1 + '|byte string| + in_0 + no-wrap-config_0))) + (catch-and-reraise-as-reader/proc + in_0 + config_0 + (lambda () + (|#%app| + (if (char=? mode-c_0 '#\x72) + byte-regexp + byte-pregexp) + bstr_0))))) + (let ((temp9_0 "expected `\"` after `~a`")) + (let ((temp10_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (let ((temp9_1 temp9_0)) + (reader-error.1 + unsafe-undefined + c4_0 + #f + unsafe-undefined + in_0 + config_0 + temp9_1 + (list temp10_0))))))))) + (let ((temp16_0 "expected `\"` or `#` after `~a`")) + (let ((temp17_0 + (accum-string-get!.1 0 accum-str_0 config_0))) + (let ((temp16_1 temp16_0)) + (reader-error.1 + unsafe-undefined + c3_0 + #f + unsafe-undefined + in_0 + config_0 + temp16_1 + (list temp17_0))))))))) + (wrap rx_0 in_0 config_0 #f))))))) (define read-extension-reader (lambda (read-one_0 read-recur_0 dispatch-c_0 in_0 config_0) (let ((extend-str_0 @@ -69196,63 +67735,61 @@ '(#\x61 #\x6e #\x67) in5_0 config6_0))) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config6_0))))) - (read-char-or-special in5_0 special1.1 source_0)))) - (begin - (if (eqv? c_0 '#\x20) - (void) - (let ((temp64_0 "expected a single space after `~a`")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in5_0 - config6_0 - temp64_0 - (list extend-str_0)))) - (read-lang.1 - get-info?1_0 - #f - #t - '|#lang| - extend-str_0 - read-recur3_0 - in5_0 - config6_0)))))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config6_0))))) + (let ((c_0 (read-char-or-special in5_0 special1.1 source_0))) + (begin + (if (eqv? c_0 '#\x20) + (void) + (let ((temp64_0 "expected a single space after `~a`")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in5_0 + config6_0 + temp64_0 + (list extend-str_0)))) + (read-lang.1 + get-info?1_0 + #f + #t + '|#lang| + extend-str_0 + read-recur3_0 + in5_0 + config6_0))))))))) (define |read-extension-#!.1| (|#%name| |read-extension-#!| (lambda (get-info?8_0 read-recur10_0 dispatch-c11_0 in12_0 config13_0) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config13_0))))) - (read-char-or-special in12_0 special1.1 source_0)))) - (begin - (if (if (char? c_0) (char-lang-nonsep? c_0) #f) - (void) - (let ((temp75_0 - (if (char? c_0) - (string dispatch-c11_0 '#\x21 c_0) - (string dispatch-c11_0 '#\x21)))) - (bad-syntax-error.1 '#\x78 in12_0 config13_0 temp75_0))) - (let ((temp66_0 (string dispatch-c11_0 '#\x21))) - (read-lang.1 - get-info?8_0 - c_0 - #f - '|#!| - temp66_0 - read-recur10_0 - in12_0 - config13_0)))))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config13_0))))) + (let ((c_0 (read-char-or-special in12_0 special1.1 source_0))) + (begin + (if (if (char? c_0) (char-lang-nonsep? c_0) #f) + (void) + (let ((temp75_0 + (if (char? c_0) + (string dispatch-c11_0 '#\x21 c_0) + (string dispatch-c11_0 '#\x21)))) + (bad-syntax-error.1 '#\x78 in12_0 config13_0 temp75_0))) + (let ((temp66_0 (string dispatch-c11_0 '#\x21))) + (read-lang.1 + get-info?8_0 + c_0 + #f + '|#!| + temp66_0 + read-recur10_0 + in12_0 + config13_0))))))))) (define read-lang.1 (|#%name| read-lang @@ -69301,12 +67838,11 @@ loop (lambda () (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config26_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config26_0))))) + (let ((c_0 (let ((c_0 (peek-char-or-special in25_0 @@ -69315,79 +67851,80 @@ source_0))) (if (eq? c_0 'special) (special1.1 'special) - c_0))))) - (if (eof-object? c_0) - (void) - (if (not (char? c_0)) - (begin - (begin-unsafe - (begin - (read-char-or-special - in25_0 - special1.1 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config26_0)))) - (void))) - (let ((temp91_0 - "found non-character while reading `#~a`")) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in25_0 - config26_0 - temp91_0 - (list extend-str23_0)))) - (if (if (char-whitespace? c_0) - (positive? - (begin-unsafe - (accum-string-pos accum-str_0))) - #f) - (void) - (if (if one-space?16_0 - (char=? c_0 '#\x20) - #f) - (let ((temp95_0 - "expected a single space after `~a`")) + c_0)))) + (if (eof-object? c_0) + (void) + (if (not (char? c_0)) + (begin + (begin-unsafe + (begin + (read-char-or-special + in25_0 + special1.1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config26_0)))) + (void))) + (let ((temp91_0 + "found non-character while reading `#~a`")) (reader-error.1 unsafe-undefined - '#\x78 + c_0 #f unsafe-undefined in25_0 config26_0 - temp95_0 - (list extend-str23_0))) - (if (let ((or-part_0 - (char-lang-nonsep? c_0))) - (if or-part_0 - or-part_0 - (char=? '#\x2f c_0))) - (begin - (begin-unsafe - (begin (read-char in25_0) (void))) - (accum-string-add! accum-str_0 c_0) - (loop_0)) - (begin - (begin-unsafe - (begin (read-char in25_0) (void))) - (let ((temp99_0 - (string-append - "expected only alphanumeric, `-`, `+`, `_`, or `/`" - " characters for `~a`, found `~a`"))) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in25_0 - config26_0 - temp99_0 - (list - extend-str23_0 - c_0))))))))))))))) + temp91_0 + (list extend-str23_0)))) + (if (if (char-whitespace? c_0) + (positive? + (begin-unsafe + (accum-string-pos accum-str_0))) + #f) + (void) + (if (if one-space?16_0 + (char=? c_0 '#\x20) + #f) + (let ((temp95_0 + "expected a single space after `~a`")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in25_0 + config26_0 + temp95_0 + (list extend-str23_0))) + (if (let ((or-part_0 + (char-lang-nonsep? c_0))) + (if or-part_0 + or-part_0 + (char=? '#\x2f c_0))) + (begin + (begin-unsafe + (begin (read-char in25_0) (void))) + (accum-string-add! accum-str_0 c_0) + (loop_0)) + (begin + (begin-unsafe + (begin (read-char in25_0) (void))) + (let ((temp99_0 + (string-append + "expected only alphanumeric, `-`, `+`, `_`, or `/`" + " characters for `~a`, found `~a`"))) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in25_0 + config26_0 + temp99_0 + (list + extend-str23_0 + c_0)))))))))))))))) (loop_0)) (let ((lang-str_0 (accum-string-get!.1 0 accum-str_0 config26_0))) @@ -69508,22 +68045,22 @@ (begin (if (null? wanted_1) (void) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (begin - (if (char? c_0) - (accum-string-add! accum-str_0 c_0) - (void)) - (if (eqv? c_0 (car wanted_1)) - (void) - (let ((temp121_0 - (accum-string-get!.1 0 accum-str_0 config_0))) - (bad-syntax-error.1 c_0 in_0 config_0 temp121_0))) - (loop_0 (cdr wanted_1)))))))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 + (read-char-or-special in_0 special1.1 source_0))) + (begin + (if (char? c_0) + (accum-string-add! accum-str_0 c_0) + (void)) + (if (eqv? c_0 (car wanted_1)) + (void) + (let ((temp121_0 + (accum-string-get!.1 0 accum-str_0 config_0))) + (bad-syntax-error.1 c_0 in_0 config_0 temp121_0))) + (loop_0 (cdr wanted_1))))))))))) (loop_0 wanted_0)) (accum-string-get!.1 0 accum-str_0 config_0))))) (define read-extension.1 @@ -69607,29 +68144,20 @@ push-authentic current-read-config config39_0 - (let ((app_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config39_0))))) - (let ((app_1 - (begin-unsafe - (read-config/outer-line - config39_0)))) - (let ((app_2 - (begin-unsafe - (read-config/outer-col - config39_0)))) - (|#%app| - extension_0 - app_0 - in38_0 - mod-path-wrapped_0 - app_1 - app_2 - (begin-unsafe - (read-config/outer-pos - config39_0))))))) + (|#%app| + extension_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config39_0))) + in38_0 + mod-path-wrapped_0 + (begin-unsafe + (read-config/outer-line config39_0)) + (begin-unsafe + (read-config/outer-col config39_0)) + (begin-unsafe + (read-config/outer-pos config39_0)))) (if (procedure-arity-includes? extension_0 2) @@ -69655,23 +68183,16 @@ push-authentic current-read-config config39_0 - (let ((app_0 - (begin-unsafe - (read-config/outer-line - config39_0)))) - (let ((app_1 - (begin-unsafe - (read-config/outer-col - config39_0)))) - (|#%app| - extension_0 - in38_0 - mod-path-wrapped_0 - app_0 - app_1 - (begin-unsafe - (read-config/outer-pos - config39_0)))))) + (|#%app| + extension_0 + in38_0 + mod-path-wrapped_0 + (begin-unsafe + (read-config/outer-line config39_0)) + (begin-unsafe + (read-config/outer-col config39_0)) + (begin-unsafe + (read-config/outer-pos config39_0)))) (if get-info?30_0 (raise-argument-error who31_0 @@ -69729,19 +68250,18 @@ (if fail-k_0 (|#%app| fail-k_0) (lang-error in_0 l-config_0 "" c_0)) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner l-config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (if (eqv? c2_0 '#\x6c) - (read-extension-lang.1 #t read-one_0 c_0 in_0 l-config_0) - (if (eqv? c2_0 '#\x21) - (|read-extension-#!.1| #t read-one_0 c_0 in_0 l-config_0) - (if fail-k_0 - (|#%app| fail-k_0) - (lang-error in_0 l-config_0 (string c_0) c2_0)))))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner l-config_0))))) + (let ((c2_0 (read-char-or-special in_0 special1.1 source_0))) + (if (eqv? c2_0 '#\x6c) + (read-extension-lang.1 #t read-one_0 c_0 in_0 l-config_0) + (if (eqv? c2_0 '#\x21) + (|read-extension-#!.1| #t read-one_0 c_0 in_0 l-config_0) + (if fail-k_0 + (|#%app| fail-k_0) + (lang-error in_0 l-config_0 (string c_0) c2_0))))))))) (args (raise-binding-result-arity-error 3 args))))))) (define lang-error (lambda (in_0 config_0 prefix_0 c_0) @@ -69905,11 +68425,11 @@ loop (lambda (v_1) (begin - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c_0 (let ((c_0 (peek-char-or-special in_0 @@ -69918,68 +68438,74 @@ source_0))) (if (eq? c_0 'special) (special1.1 'special) - c_0))))) - (let ((ec_0 (effective-char c_0 config_0))) - (if (not (char? ec_0)) - v_1 - (if (char-whitespace? ec_0) - (begin - (begin-unsafe (begin (read-char in_0) (void))) - (loop_0 v_1)) - (if (char=? ec_0 '#\x2e) - (call-with-values - (lambda () (port-next-location in_0)) - (case-lambda - ((dot-line_0 dot-col_0 dot-pos_0) - (begin - (begin-unsafe - (begin (read-char in_0) (void))) - (let ((pos-config_0 - (reading-at - config_0 - dot-line_0 - dot-col_0 - dot-pos_0))) - (let ((cdot_0 - (wrap - '|#%dot| - in_0 - pos-config_0 - '#\x2e))) - (let ((post-v_0 - (read-undotted - #f + c_0)))) + (let ((ec_0 (effective-char c_0 config_0))) + (if (not (char? ec_0)) + v_1 + (if (char-whitespace? ec_0) + (begin + (begin-unsafe + (begin (read-char in_0) (void))) + (loop_0 v_1)) + (if (char=? ec_0 '#\x2e) + (call-with-values + (lambda () (port-next-location in_0)) + (case-lambda + ((dot-line_0 dot-col_0 dot-pos_0) + (begin + (begin-unsafe + (begin (read-char in_0) (void))) + (let ((pos-config_0 + (reading-at + config_0 + dot-line_0 + dot-col_0 + dot-pos_0))) + (let ((cdot_0 + (wrap + '|#%dot| in_0 - config_0))) - (begin - (if (eof-object? post-v_0) - (let ((temp84_0 - "expected a datum after cdot, found end-of-file")) - (reader-error.1 - unsafe-undefined - eof - #f - unsafe-undefined - in_0 - pos-config_0 - temp84_0 - (list))) - (void)) - (loop_0 - (wrap - (list cdot_0 v_1 post-v_0) - in_0 - (reading-at - config_0 - line_0 - col_0 - pos_0) - '#\x2e)))))))) - (args - (raise-binding-result-arity-error - 3 - args)))) - v_1)))))))))) + pos-config_0 + '#\x2e))) + (let ((post-v_0 + (read-undotted + #f + in_0 + config_0))) + (begin + (if (eof-object? post-v_0) + (let ((temp84_0 + "expected a datum after cdot, found end-of-file")) + (reader-error.1 + unsafe-undefined + eof + #f + unsafe-undefined + in_0 + pos-config_0 + temp84_0 + (list))) + (void)) + (loop_0 + (let ((app_0 + (list + cdot_0 + v_1 + post-v_0))) + (wrap + app_0 + in_0 + (reading-at + config_0 + line_0 + col_0 + pos_0) + '#\x2e))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))) + v_1))))))))))) (loop_0 v_0))))) (args (raise-binding-result-arity-error 3 args)))) (void))))) @@ -70147,12 +68673,12 @@ (if (check-parameter 1/read-accept-quasiquote config_0) - (let ((c2_1 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) + (let ((source_0 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c2_1 (let ((c_1 (peek-char-or-special in_0 @@ -70161,25 +68687,25 @@ source_0))) (if (eq? c_1 'special) (special1.1 'special) - c_1))))) - (if (eqv? c2_1 '#\x40) - (begin - (begin-unsafe - (begin (read-char in_0) (void))) + c_1)))) + (if (eqv? c2_1 '#\x40) + (begin + (begin-unsafe + (begin (read-char in_0) (void))) + (read-quote + read-one + 'unquote-splicing + "unquoting `,@`" + c_0 + in_0 + r-config_0)) (read-quote read-one - 'unquote-splicing - "unquoting `,@`" + 'unquote + "unquoting `,`" c_0 in_0 - r-config_0)) - (read-quote - read-one - 'unquote - "unquoting `,`" - c_0 - in_0 - r-config_0))) + r-config_0)))) (let ((temp95_0 "illegal use of `~a`")) (reader-error.1 unsafe-undefined @@ -70378,25 +68904,12 @@ (args (raise-binding-result-arity-error 3 args))))))) (define read-dispatch (lambda (dispatch-c_0 in_0 config_0 orig-config_0) - (let ((c_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner config_0))))) - (read-char-or-special in_0 special1.1 source_0)))) - (if (eof-object? c_0) - (let ((temp155_0 "bad syntax `~a`")) - (reader-error.1 - unsafe-undefined - c_0 - #f - unsafe-undefined - in_0 - config_0 - temp155_0 - (list dispatch-c_0))) - (if (not (char? c_0)) - (let ((temp160_0 "bad syntax `~a`")) + (let ((source_0 + (begin-unsafe + (read-config/inner-source (read-config/outer-inner config_0))))) + (let ((c_0 (read-char-or-special in_0 special1.1 source_0))) + (if (eof-object? c_0) + (let ((temp155_0 "bad syntax `~a`")) (reader-error.1 unsafe-undefined c_0 @@ -70404,497 +68917,291 @@ unsafe-undefined in_0 config_0 - temp160_0 + temp155_0 (list dispatch-c_0))) - (let ((c3_0 (readtable-dispatch-handler orig-config_0 c_0))) - (if c3_0 - (let ((line_0 (begin-unsafe (read-config/outer-line config_0)))) - (let ((col_0 (begin-unsafe (read-config/outer-col config_0)))) - (let ((pos_0 - (begin-unsafe (read-config/outer-pos config_0)))) - (let ((v_0 - (readtable-apply - c3_0 - c_0 - in_0 - config_0 - line_0 - col_0 - pos_0))) - (retry-special-comment v_0 in_0 orig-config_0))))) - (let ((index_0 - (if (char? c_0) - (let ((codepoint_0 (char->integer c_0))) - (if (if (unsafe-fx>= codepoint_0 33) - (unsafe-fx< codepoint_0 127) - #f) - (let ((tbl_0 - '#(34 - 11 - 0 - 0 - 13 - 6 - 7 - 2 - 0 - 0 - 0 - 9 - 0 - 0 - 0 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 1 - 14 - 0 - 12 - 0 - 0 - 0 - 0 - 0 - 22 - 29 - 25 - 18 - 16 - 0 - 30 - 20 - 0 - 0 - 0 - 0 - 0 - 24 - 0 - 0 - 0 - 0 - 15 - 0 - 0 - 0 - 28 - 0 - 0 - 3 - 10 - 0 - 0 - 0 - 8 - 0 - 26 - 29 - 21 - 17 - 16 - 0 - 30 - 19 - 0 - 0 - 33 - 0 - 0 - 23 - 32 - 0 - 31 - 5 - 15 - 0 - 0 - 0 - 27 - 0 - 0 - 4 - 0 - 0 - 35))) - (unsafe-vector*-ref - tbl_0 - (unsafe-fx- codepoint_0 33))) - 0)) - 0))) - (if (unsafe-fx< index_0 17) - (if (unsafe-fx< index_0 8) - (if (unsafe-fx< index_0 3) - (if (unsafe-fx< index_0 1) - (let ((temp164_0 "bad syntax `~a~a`")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined - in_0 - config_0 - temp164_0 - (list dispatch-c_0 c_0))) - (if (unsafe-fx< index_0 2) - (read-vector-or-graph - read-one - dispatch-c_0 - c_0 - in_0 - config_0) - (read-vector.1 - #f - 'any - read-one - '#\x28 - '#\x28 - '#\x29 - in_0 - config_0))) - (if (unsafe-fx< index_0 5) - (if (unsafe-fx< index_0 4) - (if (check-parameter - 1/read-square-bracket-as-paren - config_0) - (read-vector.1 + (if (not (char? c_0)) + (let ((temp160_0 "bad syntax `~a`")) + (reader-error.1 + unsafe-undefined + c_0 + #f + unsafe-undefined + in_0 + config_0 + temp160_0 + (list dispatch-c_0))) + (let ((c3_0 (readtable-dispatch-handler orig-config_0 c_0))) + (if c3_0 + (let ((line_0 + (begin-unsafe (read-config/outer-line config_0)))) + (let ((col_0 + (begin-unsafe (read-config/outer-col config_0)))) + (let ((pos_0 + (begin-unsafe (read-config/outer-pos config_0)))) + (let ((v_0 + (readtable-apply + c3_0 + c_0 + in_0 + config_0 + line_0 + col_0 + pos_0))) + (retry-special-comment v_0 in_0 orig-config_0))))) + (let ((index_0 + (if (char? c_0) + (let ((codepoint_0 (char->integer c_0))) + (if (if (unsafe-fx>= codepoint_0 33) + (unsafe-fx< codepoint_0 127) + #f) + (let ((tbl_0 + '#(34 + 11 + 0 + 0 + 13 + 6 + 7 + 2 + 0 + 0 + 0 + 9 + 0 + 0 + 0 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 1 + 14 + 0 + 12 + 0 + 0 + 0 + 0 + 0 + 22 + 29 + 25 + 18 + 16 + 0 + 30 + 20 + 0 + 0 + 0 + 0 + 0 + 24 + 0 + 0 + 0 + 0 + 15 + 0 + 0 + 0 + 28 + 0 + 0 + 3 + 10 + 0 + 0 + 0 + 8 + 0 + 26 + 29 + 21 + 17 + 16 + 0 + 30 + 19 + 0 + 0 + 33 + 0 + 0 + 23 + 32 + 0 + 31 + 5 + 15 + 0 + 0 + 0 + 27 + 0 + 0 + 4 + 0 + 0 + 35))) + (unsafe-vector*-ref + tbl_0 + (unsafe-fx- codepoint_0 33))) + 0)) + 0))) + (if (unsafe-fx< index_0 17) + (if (unsafe-fx< index_0 8) + (if (unsafe-fx< index_0 3) + (if (unsafe-fx< index_0 1) + (let ((temp164_0 "bad syntax `~a~a`")) + (reader-error.1 + unsafe-undefined + '#\x78 #f - 'any - read-one - '#\x5b - '#\x5b - '#\x5d + unsafe-undefined in_0 - config_0) - (let ((temp181_0 (format "~a~a" dispatch-c_0 c_0))) - (bad-syntax-error.1 - '#\x78 - in_0 - config_0 - temp181_0))) - (if (check-parameter - 1/read-curly-brace-as-paren - config_0) - (read-vector.1 - #f - 'any + config_0 + temp164_0 + (list dispatch-c_0 c_0))) + (if (unsafe-fx< index_0 2) + (read-vector-or-graph read-one - '#\x7b - '#\x7b - '#\x7d - in_0 - config_0) - (let ((temp190_0 (format "~a~a" dispatch-c_0 c_0))) - (bad-syntax-error.1 - '#\x78 - in_0 - config_0 - temp190_0)))) - (if (unsafe-fx< index_0 6) - (read-struct read-one dispatch-c_0 in_0 config_0) - (if (unsafe-fx< index_0 7) - (read-box read-one dispatch-c_0 in_0 config_0) - (read-quote - read-one - 'syntax - "quoting #'" + dispatch-c_0 c_0 in_0 - config_0))))) - (if (unsafe-fx< index_0 12) - (if (unsafe-fx< index_0 9) - (read-quote - read-one - 'quasisyntax - "quasiquoting #`" - c_0 - in_0 - config_0) - (if (unsafe-fx< index_0 10) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (eqv? c2_0 '#\x40) - (begin - (begin-unsafe (begin (read-char in_0) (void))) - (read-quote - read-one - 'unsyntax-splicing - "unquoting #,@" - c_0 - in_0 - config_0)) - (read-quote - read-one - 'unsyntax - "unquoting #," - c_0 - in_0 - config_0))) - (if (unsafe-fx< index_0 11) - (read-character in_0 config_0) - (read-string.1 '|byte string| in_0 config_0)))) - (if (unsafe-fx< index_0 14) - (if (unsafe-fx< index_0 13) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (eqv? '#\x3c c2_0) - (begin - (begin-unsafe (begin (read-char in_0) (void))) - (read-here-string in_0 config_0)) - (let ((temp197_0 "bad syntax `~a<`")) - (reader-error.1 - unsafe-undefined - c2_0 - #f - unsafe-undefined - in_0 - config_0 - temp197_0 - (list dispatch-c_0))))) - (read-symbol-or-number.1 - dispatch-c_0 - 'symbol - c_0 - in_0 - config_0)) - (if (unsafe-fx< index_0 15) - (read-symbol-or-number.1 - #f - 'keyword - #f - in_0 - config_0) - (if (unsafe-fx< index_0 16) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (begin-unsafe - (readtable-char-delimiter? - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))) - c2_0 - config_0)) - (wrap #t in_0 config_0 c_0) - (read-delimited-constant - c_0 - (char=? c_0 '#\x74) - '(#\x72 #\x75 #\x65) - #t - in_0 - config_0))) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (let ((c_1 - (peek-char-or-special - in_0 - 0 - 'special - source_0))) - (if (eq? c_1 'special) - (special1.1 'special) - c_1))))) - (if (begin-unsafe - (readtable-char-delimiter? - (begin-unsafe - (read-config/inner-readtable - (read-config/outer-inner config_0))) - c2_0 - config_0)) - (wrap #f in_0 config_0 c_0) - (if (let ((or-part_0 (char=? c2_0 '#\x78))) - (if or-part_0 - or-part_0 - (char=? c2_0 '#\x6c))) - (read-fixnum-or-flonum-vector - read-one - dispatch-c_0 - c_0 - c2_0 - in_0 - config_0) - (read-delimited-constant - c_0 - (char=? c_0 '#\x66) - '(#\x61 #\x6c #\x73 #\x65) - #f - in_0 - config_0))))))))) - (if (unsafe-fx< index_0 26) - (if (unsafe-fx< index_0 21) - (if (unsafe-fx< index_0 18) - (let ((temp211_0 "#e")) - (read-symbol-or-number.1 - #f - temp211_0 - #f - in_0 - config_0)) - (if (unsafe-fx< index_0 19) - (let ((temp215_0 "#E")) - (read-symbol-or-number.1 - #f - temp215_0 - #f - in_0 - config_0)) - (if (unsafe-fx< index_0 20) - (let ((temp219_0 "#i")) - (read-symbol-or-number.1 - #f - temp219_0 - #f - in_0 - config_0)) - (let ((temp223_0 "#I")) - (read-symbol-or-number.1 - #f - temp223_0 - #f - in_0 - config_0))))) - (if (unsafe-fx< index_0 23) - (if (unsafe-fx< index_0 22) - (let ((temp227_0 "#d")) - (read-symbol-or-number.1 - #f - temp227_0 - #f - in_0 - config_0)) - (let ((temp231_0 "#B")) - (read-symbol-or-number.1 - #f - temp231_0 + config_0) + (read-vector.1 #f + 'any + read-one + '#\x28 + '#\x28 + '#\x29 in_0 config_0))) - (if (unsafe-fx< index_0 24) - (let ((temp235_0 "#o")) - (read-symbol-or-number.1 - #f - temp235_0 - #f - in_0 - config_0)) - (if (unsafe-fx< index_0 25) - (let ((temp239_0 "#O")) - (read-symbol-or-number.1 - #f - temp239_0 + (if (unsafe-fx< index_0 5) + (if (unsafe-fx< index_0 4) + (if (check-parameter + 1/read-square-bracket-as-paren + config_0) + (read-vector.1 #f + 'any + read-one + '#\x5b + '#\x5b + '#\x5d in_0 - config_0)) - (let ((temp243_0 "#D")) - (read-symbol-or-number.1 - #f - temp243_0 - #f - in_0 - config_0)))))) - (if (unsafe-fx< index_0 30) - (if (unsafe-fx< index_0 27) - (let ((temp247_0 "#b")) - (read-symbol-or-number.1 - #f - temp247_0 - #f - in_0 - config_0)) - (if (unsafe-fx< index_0 28) - (let ((temp251_0 "#x")) - (read-symbol-or-number.1 - #f - temp251_0 - #f - in_0 - config_0)) - (if (unsafe-fx< index_0 29) - (let ((temp255_0 "#X")) - (read-symbol-or-number.1 - #f - temp255_0 - #f - in_0 - config_0)) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (read-char-or-special - in_0 - special1.1 - source_0)))) - (if (if (eqv? c2_0 '#\x73) #t (eqv? c2_0 '#\x53)) - (read-one - #f + config_0) + (let ((temp181_0 + (format "~a~a" dispatch-c_0 c_0))) + (bad-syntax-error.1 + '#\x78 in_0 - (override-parameter - read-case-sensitive - config_0 - #t)) - (if (if (eqv? c2_0 '#\x69) - #t - (eqv? c2_0 '#\x49)) - (read-one - #f + config_0 + temp181_0))) + (if (check-parameter + 1/read-curly-brace-as-paren + config_0) + (read-vector.1 + #f + 'any + read-one + '#\x7b + '#\x7b + '#\x7d + in_0 + config_0) + (let ((temp190_0 + (format "~a~a" dispatch-c_0 c_0))) + (bad-syntax-error.1 + '#\x78 + in_0 + config_0 + temp190_0)))) + (if (unsafe-fx< index_0 6) + (read-struct read-one dispatch-c_0 in_0 config_0) + (if (unsafe-fx< index_0 7) + (read-box read-one dispatch-c_0 in_0 config_0) + (read-quote + read-one + 'syntax + "quoting #'" + c_0 + in_0 + config_0))))) + (if (unsafe-fx< index_0 12) + (if (unsafe-fx< index_0 9) + (read-quote + read-one + 'quasisyntax + "quasiquoting #`" + c_0 + in_0 + config_0) + (if (unsafe-fx< index_0 10) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c2_0 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (eqv? c2_0 '#\x40) + (begin + (begin-unsafe + (begin (read-char in_0) (void))) + (read-quote + read-one + 'unsyntax-splicing + "unquoting #,@" + c_0 + in_0 + config_0)) + (read-quote + read-one + 'unsyntax + "unquoting #," + c_0 in_0 - (override-parameter - read-case-sensitive - config_0 - #f)) - (let ((temp259_0 - "expected `s', `S`, `i`, or `I` after `~a~a`")) + config_0)))) + (if (unsafe-fx< index_0 11) + (read-character in_0 config_0) + (read-string.1 '|byte string| in_0 config_0)))) + (if (unsafe-fx< index_0 14) + (if (unsafe-fx< index_0 13) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c2_0 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (eqv? '#\x3c c2_0) + (begin + (begin-unsafe + (begin (read-char in_0) (void))) + (read-here-string in_0 config_0)) + (let ((temp197_0 "bad syntax `~a<`")) (reader-error.1 unsafe-undefined c2_0 @@ -70902,126 +69209,346 @@ unsafe-undefined in_0 config_0 - temp259_0 - (list dispatch-c_0 c_0))))))))) - (if (unsafe-fx< index_0 32) - (if (unsafe-fx< index_0 31) - (read-hash read-one dispatch-c_0 c_0 in_0 config_0) - (let ((accum-str_0 (accum-string-init! config_0))) - (begin - (accum-string-add! accum-str_0 dispatch-c_0) - (begin - (accum-string-add! accum-str_0 c_0) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (read-char-or-special - in_0 - special1.1 - source_0)))) - (begin - (if (char? c2_0) - (accum-string-add! accum-str_0 c2_0) - (void)) - (if (eqv? c2_0 '#\x78) - (read-regexp - c_0 - accum-str_0 - in_0 - config_0) - (if (eqv? c2_0 '#\x65) - (read-extension-reader - read-one - read-undotted - dispatch-c_0 - in_0 - config_0) - (let ((temp265_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (bad-syntax-error.1 - c2_0 - in_0 - config_0 - temp265_0)))))))))) - (if (unsafe-fx< index_0 33) - (let ((accum-str_0 (accum-string-init! config_0))) - (begin - (accum-string-add! accum-str_0 dispatch-c_0) - (begin - (accum-string-add! accum-str_0 c_0) - (let ((c2_0 - (let ((source_0 - (begin-unsafe - (read-config/inner-source - (read-config/outer-inner - config_0))))) - (read-char-or-special - in_0 - special1.1 - source_0)))) - (begin - (if (char? c2_0) - (accum-string-add! accum-str_0 c2_0) - (void)) - (if (eqv? c2_0 '#\x78) - (read-regexp - c_0 - accum-str_0 - in_0 - config_0) - (let ((temp271_0 - (accum-string-get!.1 - 0 - accum-str_0 - config_0))) - (bad-syntax-error.1 - c2_0 - in_0 - config_0 - temp271_0)))))))) - (if (unsafe-fx< index_0 34) - (read-extension-lang.1 - #f - read-undotted + temp197_0 + (list dispatch-c_0)))))) + (read-symbol-or-number.1 dispatch-c_0 + 'symbol + c_0 + in_0 + config_0)) + (if (unsafe-fx< index_0 15) + (read-symbol-or-number.1 + #f + 'keyword + #f in_0 config_0) - (if (unsafe-fx< index_0 35) - (|read-extension-#!.1| + (if (unsafe-fx< index_0 16) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c2_0 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (begin-unsafe + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner config_0))) + c2_0 + config_0)) + (wrap #t in_0 config_0 c_0) + (read-delimited-constant + c_0 + (char=? c_0 '#\x74) + '(#\x72 #\x75 #\x65) + #t + in_0 + config_0)))) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c2_0 + (let ((c_1 + (peek-char-or-special + in_0 + 0 + 'special + source_1))) + (if (eq? c_1 'special) + (special1.1 'special) + c_1)))) + (if (begin-unsafe + (readtable-char-delimiter? + (begin-unsafe + (read-config/inner-readtable + (read-config/outer-inner config_0))) + c2_0 + config_0)) + (wrap #f in_0 config_0 c_0) + (if (let ((or-part_0 (char=? c2_0 '#\x78))) + (if or-part_0 + or-part_0 + (char=? c2_0 '#\x6c))) + (read-fixnum-or-flonum-vector + read-one + dispatch-c_0 + c_0 + c2_0 + in_0 + config_0) + (read-delimited-constant + c_0 + (char=? c_0 '#\x66) + '(#\x61 #\x6c #\x73 #\x65) + #f + in_0 + config_0)))))))))) + (if (unsafe-fx< index_0 26) + (if (unsafe-fx< index_0 21) + (if (unsafe-fx< index_0 18) + (let ((temp211_0 "#e")) + (read-symbol-or-number.1 + #f + temp211_0 + #f + in_0 + config_0)) + (if (unsafe-fx< index_0 19) + (let ((temp215_0 "#E")) + (read-symbol-or-number.1 + #f + temp215_0 + #f + in_0 + config_0)) + (if (unsafe-fx< index_0 20) + (let ((temp219_0 "#i")) + (read-symbol-or-number.1 + #f + temp219_0 + #f + in_0 + config_0)) + (let ((temp223_0 "#I")) + (read-symbol-or-number.1 + #f + temp223_0 + #f + in_0 + config_0))))) + (if (unsafe-fx< index_0 23) + (if (unsafe-fx< index_0 22) + (let ((temp227_0 "#d")) + (read-symbol-or-number.1 + #f + temp227_0 + #f + in_0 + config_0)) + (let ((temp231_0 "#B")) + (read-symbol-or-number.1 + #f + temp231_0 + #f + in_0 + config_0))) + (if (unsafe-fx< index_0 24) + (let ((temp235_0 "#o")) + (read-symbol-or-number.1 + #f + temp235_0 + #f + in_0 + config_0)) + (if (unsafe-fx< index_0 25) + (let ((temp239_0 "#O")) + (read-symbol-or-number.1 + #f + temp239_0 + #f + in_0 + config_0)) + (let ((temp243_0 "#D")) + (read-symbol-or-number.1 + #f + temp243_0 + #f + in_0 + config_0)))))) + (if (unsafe-fx< index_0 30) + (if (unsafe-fx< index_0 27) + (let ((temp247_0 "#b")) + (read-symbol-or-number.1 + #f + temp247_0 + #f + in_0 + config_0)) + (if (unsafe-fx< index_0 28) + (let ((temp251_0 "#x")) + (read-symbol-or-number.1 + #f + temp251_0 + #f + in_0 + config_0)) + (if (unsafe-fx< index_0 29) + (let ((temp255_0 "#X")) + (read-symbol-or-number.1 + #f + temp255_0 + #f + in_0 + config_0)) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner config_0))))) + (let ((c2_0 + (read-char-or-special + in_0 + special1.1 + source_1))) + (if (if (eqv? c2_0 '#\x73) + #t + (eqv? c2_0 '#\x53)) + (read-one + #f + in_0 + (override-parameter + read-case-sensitive + config_0 + #t)) + (if (if (eqv? c2_0 '#\x69) + #t + (eqv? c2_0 '#\x49)) + (read-one + #f + in_0 + (override-parameter + read-case-sensitive + config_0 + #f)) + (let ((temp259_0 + "expected `s', `S`, `i`, or `I` after `~a~a`")) + (reader-error.1 + unsafe-undefined + c2_0 + #f + unsafe-undefined + in_0 + config_0 + temp259_0 + (list dispatch-c_0 c_0)))))))))) + (if (unsafe-fx< index_0 32) + (if (unsafe-fx< index_0 31) + (read-hash read-one dispatch-c_0 c_0 in_0 config_0) + (let ((accum-str_0 (accum-string-init! config_0))) + (begin + (accum-string-add! accum-str_0 dispatch-c_0) + (begin + (accum-string-add! accum-str_0 c_0) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c2_0 + (read-char-or-special + in_0 + special1.1 + source_1))) + (begin + (if (char? c2_0) + (accum-string-add! accum-str_0 c2_0) + (void)) + (if (eqv? c2_0 '#\x78) + (read-regexp + c_0 + accum-str_0 + in_0 + config_0) + (if (eqv? c2_0 '#\x65) + (read-extension-reader + read-one + read-undotted + dispatch-c_0 + in_0 + config_0) + (let ((temp265_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (bad-syntax-error.1 + c2_0 + in_0 + config_0 + temp265_0))))))))))) + (if (unsafe-fx< index_0 33) + (let ((accum-str_0 (accum-string-init! config_0))) + (begin + (accum-string-add! accum-str_0 dispatch-c_0) + (begin + (accum-string-add! accum-str_0 c_0) + (let ((source_1 + (begin-unsafe + (read-config/inner-source + (read-config/outer-inner + config_0))))) + (let ((c2_0 + (read-char-or-special + in_0 + special1.1 + source_1))) + (begin + (if (char? c2_0) + (accum-string-add! accum-str_0 c2_0) + (void)) + (if (eqv? c2_0 '#\x78) + (read-regexp + c_0 + accum-str_0 + in_0 + config_0) + (let ((temp271_0 + (accum-string-get!.1 + 0 + accum-str_0 + config_0))) + (bad-syntax-error.1 + c2_0 + in_0 + config_0 + temp271_0))))))))) + (if (unsafe-fx< index_0 34) + (read-extension-lang.1 #f read-undotted dispatch-c_0 in_0 config_0) - (if (check-parameter - 1/read-accept-compiled - config_0) - (wrap - (|#%app| - (begin-unsafe - (read-config/inner-read-compiled - (read-config/outer-inner config_0))) - in_0) + (if (unsafe-fx< index_0 35) + (|read-extension-#!.1| + #f + read-undotted + dispatch-c_0 in_0 - config_0 - c_0) - (let ((temp284_0 - "`~a~~` compiled expressions not enabled")) - (reader-error.1 - unsafe-undefined - '#\x78 - #f - unsafe-undefined + config_0) + (if (check-parameter + 1/read-accept-compiled + config_0) + (wrap + (|#%app| + (begin-unsafe + (read-config/inner-read-compiled + (read-config/outer-inner config_0))) + in_0) in_0 config_0 - temp284_0 - (list dispatch-c_0))))))))))))))))))) + c_0) + (let ((temp284_0 + "`~a~~` compiled expressions not enabled")) + (reader-error.1 + unsafe-undefined + '#\x78 + #f + unsafe-undefined + in_0 + config_0 + temp284_0 + (list dispatch-c_0)))))))))))))))))))) (define retry-special-comment (lambda (v_0 in_0 config_0) (if (1/special-comment? v_0) @@ -71120,8 +69647,9 @@ temp41 (lambda (m_0) (begin - (let ((app_0 (module-provides m_0))) - (values app_0 (module-self m_0)))))))) + (values + (module-provides m_0) + (module-self m_0))))))) (let ((temp44_0 (lambda () (check-provides-verbosity @@ -71233,18 +69761,18 @@ name_0)) (if (namespace-get-root-expand-ctx m-ns_0) (void) - (let ((root-ctx_0 - (let ((temp60_0 (namespace-mpi m-ns_0))) + (let ((temp60_0 (namespace-mpi m-ns_0))) + (let ((root-ctx_0 (make-root-expand-context.1 #f null unsafe-undefined unsafe-undefined - temp60_0)))) - (begin-unsafe - (set-box! - (namespace-root-expand-ctx m-ns_0) - root-ctx_0)))) + temp60_0))) + (begin-unsafe + (set-box! + (namespace-root-expand-ctx m-ns_0) + root-ctx_0))))) (let ((temp53_0 (namespace-mpi m-ns_0))) (namespace-module-make-available!.1 unsafe-undefined @@ -71592,10 +70120,8 @@ (begin (if (> len_0 (add1 prev-len_1)) (let ((app_0 (add1 prev-len_1))) - (sloop_0 - app_0 - (cons accum_1 stack_1) - (hasheq))) + (let ((app_1 (cons accum_1 stack_1))) + (sloop_0 app_0 app_1 (hasheq)))) (let ((path_1 (list-tail path_0 @@ -71780,17 +70306,14 @@ original-curly-props original-props)))) (let ((content*57_1 content*57_0)) - (let ((app_0 (syntax-scopes empty-syntax))) - (let ((app_1 (syntax-shifted-multi-scopes empty-syntax))) - (let ((app_2 (syntax-mpi-shifts empty-syntax))) - (syntax2.1 - content*57_1 - app_0 - app_1 - app_2 - srcloc_0 - props59_0 - (syntax-inspector empty-syntax)))))))) + (syntax2.1 + content*57_1 + (syntax-scopes empty-syntax) + (syntax-shifted-multi-scopes empty-syntax) + (syntax-mpi-shifts empty-syntax) + srcloc_0 + props59_0 + (syntax-inspector empty-syntax))))) (raise-argument-error 'struct-copy "syntax?" empty-syntax)))) (define original-props (syntax-props (syntax-property$1 empty-syntax original-property-sym #t))) @@ -72335,12 +70858,13 @@ post_0 errstr_0))))) (let ((app_1 (current-continuation-marks))) - (|#%app| - 1/make-exn:fail:syntax:missing-module - app_0 - app_1 - (list path_0) - (syntax->datum$1 path_0))))) + (let ((app_2 (list path_0))) + (|#%app| + 1/make-exn:fail:syntax:missing-module + app_0 + app_1 + app_2 + (syntax->datum$1 path_0)))))) (void)) (raise (let ((app_0 @@ -73036,9 +71560,10 @@ (lambda (vr_0) (let ((inst_0 (variable-reference->instance vr_0))) (if (symbol? inst_0) - (1/module->namespace - (list 'quote inst_0) - (instance-data (variable-reference->instance vr_0 #t))) + (let ((app_0 (list 'quote inst_0))) + (1/module->namespace + app_0 + (instance-data (variable-reference->instance vr_0 #t)))) (if (not inst_0) (instance-data (variable-reference->instance vr_0 #t)) (instance-data inst_0)))))) @@ -73958,14 +72483,12 @@ (let ((table_2 (let ((ht_0 (hash-ref - (let ((app_0 - (module-provides - m_0))) - (shift-provides-module-path-index - app_0 - (module-self - m_0) - require-mpi_0)) + (shift-provides-module-path-index + (module-provides + m_0) + (module-self + m_0) + require-mpi_0) 0))) (begin (letrec* @@ -75388,7 +73911,8 @@ (define register-zo-path (lambda (name_0 ns-hts_0 path_0 src-path_0 base_0) (if ns-hts_0 - (hash-set! (cdr ns-hts_0) name_0 (list path_0 src-path_0 base_0)) + (let ((app_0 (cdr ns-hts_0))) + (hash-set! app_0 name_0 (list path_0 src-path_0 base_0))) (void)))) (define default-reader-guard (lambda (path_0) path_0)) (define cell.1 (unsafe-make-place-local (make-weak-hasheq))) @@ -75763,12 +74287,14 @@ s_0)))))) (raise (if stx_0 - (|#%app| - 1/make-exn:fail:syntax:missing-module - msg_1 - (current-continuation-marks) - (list stx_0) - s_0) + (let ((app_0 + (current-continuation-marks))) + (|#%app| + 1/make-exn:fail:syntax:missing-module + msg_1 + app_0 + (list stx_0) + s_0)) (|#%app| 1/make-exn:fail:filesystem:missing-module msg_1 @@ -76386,18 +74912,20 @@ s_2 (get-dir_1)) s_2))) - (path-cache-set! - app_0 - (if (string? - s_2) - #f - (get-reg_1)) - (vector - filename_0 - normal-filename_0 - name_0 - no-sfx_0 - root-modname_0))) + (let ((app_1 + (if (string? + s_2) + #f + (get-reg_1)))) + (path-cache-set! + app_0 + app_1 + (vector + filename_0 + normal-filename_0 + name_0 + no-sfx_0 + root-modname_0)))) (void)) modname_0)))))) (args @@ -76562,43 +75090,26 @@ (let ((inner60_0 (root-expand-context/outer-inner ctx6_0))) - (let ((reference-records59_1 - reference-records59_0) - (use-site-scopes57_1 - use-site-scopes57_0) - (scopes56_1 scopes56_0) - (post-expansion55_1 - post-expansion55_0) - (context51_1 context51_0)) - (let ((app_0 - (expand-context/outer-env - ctx6_0))) - (let ((app_1 - (expand-context/outer-binding-layer - ctx6_0))) - (let ((app_2 - (expand-context/outer-need-eventually-defined - ctx6_0))) - (let ((app_3 - (expand-context/outer-current-introduction-scopes - ctx6_0))) - (expand-context/outer1.1 - inner60_0 - post-expansion55_1 - use-site-scopes57_1 - frame-id_0 - context51_1 - app_0 - scopes56_1 - def-ctx-scopes_0 - app_1 - reference-records59_1 - #t - app_2 - app_3 - (expand-context/outer-current-use-scopes - ctx6_0) - #f)))))))))))) + (expand-context/outer1.1 + inner60_0 + post-expansion55_0 + use-site-scopes57_0 + frame-id_0 + context51_0 + (expand-context/outer-env ctx6_0) + scopes56_0 + def-ctx-scopes_0 + (expand-context/outer-binding-layer + ctx6_0) + reference-records59_0 + #t + (expand-context/outer-need-eventually-defined + ctx6_0) + (expand-context/outer-current-introduction-scopes + ctx6_0) + (expand-context/outer-current-use-scopes + ctx6_0) + #f))))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -76608,15 +75119,13 @@ maybe-increment-binding-layer (lambda (ids_0 body-ctx_1) (begin - (if (let ((app_0 - (begin-unsafe - (expand-context/outer-binding-layer - body-ctx_1)))) - (eq? - app_0 - (begin-unsafe - (expand-context/outer-binding-layer - ctx6_0)))) + (if (eq? + (begin-unsafe + (expand-context/outer-binding-layer + body-ctx_1)) + (begin-unsafe + (expand-context/outer-binding-layer + ctx6_0))) (increment-binding-layer ids_0 body-ctx_1 @@ -76709,59 +75218,35 @@ (let ((inner80_0 (root-expand-context/outer-inner body-ctx_1))) - (let ((app_0 - (root-expand-context/outer-post-expansion - body-ctx_1))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - body-ctx_1))) - (let ((app_2 - (root-expand-context/outer-frame-id - body-ctx_1))) - (let ((app_3 - (expand-context/outer-context - body-ctx_1))) - (let ((app_4 - (expand-context/outer-env - body-ctx_1))) - (let ((app_5 - (expand-context/outer-scopes - body-ctx_1))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - body-ctx_1))) - (let ((app_7 - (expand-context/outer-binding-layer - body-ctx_1))) - (let ((app_8 - (expand-context/outer-reference-records - body-ctx_1))) - (let ((app_9 - (expand-context/outer-only-immediate? - body-ctx_1))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - body-ctx_1))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - body-ctx_1))) - (expand-context/outer1.1 - inner80_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-current-use-scopes - body-ctx_1) - name_0)))))))))))))) + (expand-context/outer1.1 + inner80_0 + (root-expand-context/outer-post-expansion + body-ctx_1) + (root-expand-context/outer-use-site-scopes + body-ctx_1) + (root-expand-context/outer-frame-id + body-ctx_1) + (expand-context/outer-context + body-ctx_1) + (expand-context/outer-env + body-ctx_1) + (expand-context/outer-scopes + body-ctx_1) + (expand-context/outer-def-ctx-scopes + body-ctx_1) + (expand-context/outer-binding-layer + body-ctx_1) + (expand-context/outer-reference-records + body-ctx_1) + (expand-context/outer-only-immediate? + body-ctx_1) + (expand-context/outer-need-eventually-defined + body-ctx_1) + (expand-context/outer-current-introduction-scopes + body-ctx_1) + (expand-context/outer-current-use-scopes + body-ctx_1) + name_0)) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -77235,56 +75720,34 @@ body-ctx_1))) (let ((binding-layer106_1 binding-layer106_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion - body-ctx_1))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - body-ctx_1))) - (let ((app_2 - (root-expand-context/outer-frame-id - body-ctx_1))) - (let ((app_3 - (expand-context/outer-context - body-ctx_1))) - (let ((app_4 - (expand-context/outer-scopes - body-ctx_1))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - body-ctx_1))) - (let ((app_6 - (expand-context/outer-reference-records - body-ctx_1))) - (let ((app_7 - (expand-context/outer-only-immediate? - body-ctx_1))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - body-ctx_1))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - body-ctx_1))) - (let ((app_10 - (expand-context/outer-current-use-scopes - body-ctx_1))) - (expand-context/outer1.1 - inner107_0 - app_0 - app_1 - app_2 - app_3 - extended-env_0 - app_4 - app_5 - binding-layer106_1 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - body-ctx_1)))))))))))))))) + (expand-context/outer1.1 + inner107_0 + (root-expand-context/outer-post-expansion + body-ctx_1) + (root-expand-context/outer-use-site-scopes + body-ctx_1) + (root-expand-context/outer-frame-id + body-ctx_1) + (expand-context/outer-context + body-ctx_1) + extended-env_0 + (expand-context/outer-scopes + body-ctx_1) + (expand-context/outer-def-ctx-scopes + body-ctx_1) + binding-layer106_1 + (expand-context/outer-reference-records + body-ctx_1) + (expand-context/outer-only-immediate? + body-ctx_1) + (expand-context/outer-need-eventually-defined + body-ctx_1) + (expand-context/outer-current-introduction-scopes + body-ctx_1) + (expand-context/outer-current-use-scopes + body-ctx_1) + (expand-context/outer-name + body-ctx_1))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -77859,91 +76322,71 @@ body-ctx_1))) (let ((binding-layer132_1 binding-layer132_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion - body-ctx_1))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - body-ctx_1))) - (let ((app_2 - (root-expand-context/outer-frame-id - body-ctx_1))) - (let ((app_3 - (expand-context/outer-context - body-ctx_1))) - (let ((app_4 - (expand-context/outer-scopes - body-ctx_1))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - body-ctx_1))) - (let ((app_6 - (expand-context/outer-reference-records - body-ctx_1))) - (let ((app_7 - (expand-context/outer-only-immediate? - body-ctx_1))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - body-ctx_1))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - body-ctx_1))) - (let ((app_10 - (expand-context/outer-current-use-scopes - body-ctx_1))) - (expand-context/outer1.1 - inner133_0 - app_0 - app_1 - app_2 - app_3 - extended-env_0 - app_4 - app_5 - binding-layer132_1 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - body-ctx_1)))))))))))))))) + (expand-context/outer1.1 + inner133_0 + (root-expand-context/outer-post-expansion + body-ctx_1) + (root-expand-context/outer-use-site-scopes + body-ctx_1) + (root-expand-context/outer-frame-id + body-ctx_1) + (expand-context/outer-context + body-ctx_1) + extended-env_0 + (expand-context/outer-scopes + body-ctx_1) + (expand-context/outer-def-ctx-scopes + body-ctx_1) + binding-layer132_1 + (expand-context/outer-reference-records + body-ctx_1) + (expand-context/outer-only-immediate? + body-ctx_1) + (expand-context/outer-need-eventually-defined + body-ctx_1) + (expand-context/outer-current-introduction-scopes + body-ctx_1) + (expand-context/outer-current-use-scopes + body-ctx_1) + (expand-context/outer-name + body-ctx_1))))) (raise-argument-error 'struct-copy "expand-context/outer?" body-ctx_1)))) (let ((app_1 (cons - (keep-as-needed.1 - #t - #f - #f - body-ctx_1 - exp-body_0) - trans-stxs_0))) - (loop_0 - app_0 - rest-bodys_0 - done-bodys_0 - val-idss_0 - val-keyss_0 - val-rhss_0 - track-stxs_0 - (cons - ids_0 - trans-idss_0) - app_1 - (cons - (datum->syntax$1 - #f - (list - ids_0 - rhs113_0) - exp-body_0) - stx-clauses_0) - new-dups_0 - #t)))))))))))))))) + ids_0 + trans-idss_0))) + (let ((app_2 + (cons + (keep-as-needed.1 + #t + #f + #f + body-ctx_1 + exp-body_0) + trans-stxs_0))) + (loop_0 + app_0 + rest-bodys_0 + done-bodys_0 + val-idss_0 + val-keyss_0 + val-rhss_0 + track-stxs_0 + app_1 + app_2 + (cons + (datum->syntax$1 + #f + (list + ids_0 + rhs113_0) + exp-body_0) + stx-clauses_0) + new-dups_0 + #t))))))))))))))))) (args (raise-binding-result-arity-error 4 @@ -77970,13 +76413,15 @@ (list (datum->syntax$1 #f - (cons - (core-id - '|#%stratified-body| - phase_0) - (cons - exp-body_0 - rest-bodys_0))))) + (let ((app_0 + (core-id + '|#%stratified-body| + phase_0))) + (cons + app_0 + (cons + exp-body_0 + rest-bodys_0)))))) val-idss_0 val-keyss_0 val-rhss_0 @@ -78067,41 +76512,23 @@ (root-expand-context/outer-inner v_0))) (let ((scopes139_1 scopes139_0) (use-site-scopes138_1 use-site-scopes138_0)) - (let ((app_0 - (root-expand-context/outer-frame-id v_0))) - (let ((app_1 (expand-context/outer-env v_0))) - (let ((app_2 - (expand-context/outer-binding-layer - v_0))) - (let ((app_3 - (expand-context/outer-reference-records - v_0))) - (let ((app_4 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_5 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_6 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner143_0 - #f - use-site-scopes138_1 - app_0 - 'expression - app_1 - scopes139_1 - #f - app_2 - app_3 - #f - app_4 - app_5 - app_6 - (expand-context/outer-name - v_0))))))))))))) + (expand-context/outer1.1 + inner143_0 + #f + use-site-scopes138_1 + (root-expand-context/outer-frame-id v_0) + 'expression + (expand-context/outer-env v_0) + scopes139_1 + #f + (expand-context/outer-binding-layer v_0) + (expand-context/outer-reference-records v_0) + #f + (expand-context/outer-need-eventually-defined v_0) + (expand-context/outer-current-introduction-scopes + v_0) + (expand-context/outer-current-use-scopes v_0) + (expand-context/outer-name v_0)))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -78163,59 +76590,35 @@ (let ((inner147_0 (root-expand-context/outer-inner finish-ctx_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - finish-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - finish-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - finish-ctx_0))) - (let ((app_3 - (expand-context/outer-context - finish-ctx_0))) - (let ((app_4 - (expand-context/outer-env - finish-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - finish-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - finish-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - finish-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - finish-ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - finish-ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - finish-ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - finish-ctx_0))) - (expand-context/outer1.1 - inner147_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-current-use-scopes - finish-ctx_0) - name12_0)))))))))))))) + (expand-context/outer1.1 + inner147_0 + (root-expand-context/outer-post-expansion + finish-ctx_0) + (root-expand-context/outer-use-site-scopes + finish-ctx_0) + (root-expand-context/outer-frame-id + finish-ctx_0) + (expand-context/outer-context + finish-ctx_0) + (expand-context/outer-env + finish-ctx_0) + (expand-context/outer-scopes + finish-ctx_0) + (expand-context/outer-def-ctx-scopes + finish-ctx_0) + (expand-context/outer-binding-layer + finish-ctx_0) + (expand-context/outer-reference-records + finish-ctx_0) + (expand-context/outer-only-immediate? + finish-ctx_0) + (expand-context/outer-need-eventually-defined + finish-ctx_0) + (expand-context/outer-current-introduction-scopes + finish-ctx_0) + (expand-context/outer-current-use-scopes + finish-ctx_0) + name12_0)) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -78466,14 +76869,15 @@ (let ((app_0 (keep-properties-only source35_0))) - (parsed-let-values17.1 - app_0 - (list ids_0) - (list - (list - (car keyss_0) - expanded-rhs_0)) - exp-rest_0)) + (let ((app_1 (list ids_0))) + (parsed-let-values17.1 + app_0 + app_1 + (list + (list + (car keyss_0) + expanded-rhs_0)) + exp-rest_0))) (let ((temp166_0 (let ((app_0 (core-id @@ -78571,23 +76975,27 @@ (let ((app_1 (cdr keyss_0))) (let ((app_2 (cdr rhss_0))) (let ((app_3 (cdr track-stxs_0))) - (loop_0 - app_0 - app_1 - app_2 - app_3 - (cons ids_0 accum-idss_0) - (cons - (car keyss_0) - accum-keyss_0) - (cons - expanded-rhs_0 - accum-rhss_0) - (cons - track-stx_0 - accum-track-stxs_0) - track?_0 - get-list?_0)))))))))))))))))))) + (let ((app_4 + (cons ids_0 accum-idss_0))) + (let ((app_5 + (cons + (car keyss_0) + accum-keyss_0))) + (loop_0 + app_0 + app_1 + app_2 + app_3 + app_4 + app_5 + (cons + expanded-rhs_0 + accum-rhss_0) + (cons + track-stx_0 + accum-track-stxs_0) + track?_0 + get-list?_0)))))))))))))))))))))) (loop_0 idss46_0 keyss47_0 @@ -78792,50 +77200,32 @@ (let ((binding-layer26_1 binding-layer26_0) (scopes25_1 scopes25_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (expand-context/outer-context - ctx_0))) - (let ((app_3 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_4 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_5 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_6 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_7 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_8 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner28_0 - app_0 - app_1 - #f - app_2 - body-env_0 - scopes25_1 - app_3 - binding-layer26_1 - app_4 - app_5 - app_6 - app_7 - app_8 - (expand-context/outer-name - ctx_0))))))))))))))) + (expand-context/outer1.1 + inner28_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + #f + (expand-context/outer-context + ctx_0) + body-env_0 + scopes25_1 + (expand-context/outer-def-ctx-scopes + ctx_0) + binding-layer26_1 + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? + ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name + ctx_0)))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -81379,50 +79769,32 @@ reference-records173_0) (scopes172_1 scopes172_0)) - (let ((app_0 - (root-expand-context/outer-post-expansion - expr-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - expr-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - expr-ctx_0))) - (let ((app_3 - (expand-context/outer-context - expr-ctx_0))) - (let ((app_4 - (expand-context/outer-def-ctx-scopes - expr-ctx_0))) - (let ((app_5 - (expand-context/outer-only-immediate? - expr-ctx_0))) - (let ((app_6 - (expand-context/outer-need-eventually-defined - expr-ctx_0))) - (let ((app_7 - (expand-context/outer-current-introduction-scopes - expr-ctx_0))) - (let ((app_8 - (expand-context/outer-current-use-scopes - expr-ctx_0))) - (expand-context/outer1.1 - inner175_0 - app_0 - app_1 - app_2 - app_3 - rec-env_0 - scopes172_1 - app_4 - binding-layer174_1 - reference-records173_1 - app_5 - app_6 - app_7 - app_8 - (expand-context/outer-name - expr-ctx_0)))))))))))))))) + (expand-context/outer1.1 + inner175_0 + (root-expand-context/outer-post-expansion + expr-ctx_0) + (root-expand-context/outer-use-site-scopes + expr-ctx_0) + (root-expand-context/outer-frame-id + expr-ctx_0) + (expand-context/outer-context + expr-ctx_0) + rec-env_0 + scopes172_1 + (expand-context/outer-def-ctx-scopes + expr-ctx_0) + binding-layer174_1 + reference-records173_1 + (expand-context/outer-only-immediate? + expr-ctx_0) + (expand-context/outer-need-eventually-defined + expr-ctx_0) + (expand-context/outer-current-introduction-scopes + expr-ctx_0) + (expand-context/outer-current-use-scopes + expr-ctx_0) + (expand-context/outer-name + expr-ctx_0))))))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -81568,59 +79940,35 @@ (let ((inner185_0 (root-expand-context/outer-inner rec-ctx_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - rec-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - rec-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - rec-ctx_0))) - (let ((app_3 - (expand-context/outer-context - rec-ctx_0))) - (let ((app_4 - (expand-context/outer-env - rec-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - rec-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - rec-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - rec-ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - rec-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - rec-ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - rec-ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - rec-ctx_0))) - (expand-context/outer1.1 - inner185_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - orig-rrs_0 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - rec-ctx_0))))))))))))))) + (expand-context/outer1.1 + inner185_0 + (root-expand-context/outer-post-expansion + rec-ctx_0) + (root-expand-context/outer-use-site-scopes + rec-ctx_0) + (root-expand-context/outer-frame-id + rec-ctx_0) + (expand-context/outer-context + rec-ctx_0) + (expand-context/outer-env + rec-ctx_0) + (expand-context/outer-scopes + rec-ctx_0) + (expand-context/outer-def-ctx-scopes + rec-ctx_0) + (expand-context/outer-binding-layer + rec-ctx_0) + orig-rrs_0 + (expand-context/outer-only-immediate? + rec-ctx_0) + (expand-context/outer-need-eventually-defined + rec-ctx_0) + (expand-context/outer-current-introduction-scopes + rec-ctx_0) + (expand-context/outer-current-use-scopes + rec-ctx_0) + (expand-context/outer-name + rec-ctx_0))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -83134,19 +81482,18 @@ (expand-context/inner-phase (root-expand-context/outer-inner ctx_0))))) (let ((xform_0 (lambda (l_0) (cons id_0 l_0)))) - (let ((key_1 key_0) (ht_1 ht_0)) - (begin-unsafe - (do-hash-update - 'hash-update! - #t - hash-set! - ht_1 - key_1 - xform_0 - null)))))) + (begin-unsafe + (do-hash-update + 'hash-update! + #t + hash-set! + ht_0 + key_0 + xform_0 + null))))) #t) #f))) -(define effect_2344 +(define effect_2123 (begin (void (add-core-form!* @@ -83219,12 +81566,11 @@ (raise-binding-result-arity-error 3 args))))))) - (let ((b_0 - (let ((temp367_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - ctx361_0))))) + (let ((temp367_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx361_0))))) + (let ((b_0 (resolve+shift.1 'ambiguous #f @@ -83232,154 +81578,162 @@ unsafe-undefined #f id_0 - temp367_0)))) - (if (eq? b_0 'ambiguous) - (raise-ambiguous-error id_0 ctx361_0) - (if (if b_0 - (if (module-binding? b_0) - (let ((app_0 (module-binding-module b_0))) - (eq? - app_0 - (begin-unsafe - (root-expand-context/inner-self-mpi - (root-expand-context/outer-inner - ctx361_0))))) + temp367_0))) + (if (eq? b_0 'ambiguous) + (raise-ambiguous-error id_0 ctx361_0) + (if (if b_0 + (if (module-binding? b_0) + (let ((app_0 + (module-binding-module b_0))) + (eq? + app_0 + (begin-unsafe + (root-expand-context/inner-self-mpi + (root-expand-context/outer-inner + ctx361_0))))) + #f) #f) - #f) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx361_0))) - (parsed-id2.1 id_0 b_0 #f) - (if (let ((mpi_0 (module-binding-module b_0))) - (begin-unsafe - (eq? - top-level-module-path-index - mpi_0))) - s360_0 - id_0)) - (if (register-eventual-variable!? id_0 ctx361_0) (if (begin-unsafe (expand-context/inner-to-parsed? (root-expand-context/outer-inner ctx361_0))) (parsed-id2.1 id_0 b_0 #f) - id_0) - (if (not - (begin-unsafe - (expand-context/inner-allow-unbound? - (root-expand-context/outer-inner - ctx361_0)))) - (raise-unbound-syntax-error - #f - "unbound identifier" - id_0 - #f - null - (syntax-debug-info-string id_0 ctx361_0)) - (let ((tl-id_0 - (add-scope - id_0 - (begin-unsafe - (root-expand-context/inner-top-level-bind-scope - (root-expand-context/outer-inner - ctx361_0)))))) - (let ((tl-b_0 - (let ((temp370_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - ctx361_0))))) - (resolve.1 - #f - #f - null - #f - tl-id_0 - temp370_0)))) - (if tl-b_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx361_0))) - (parsed-top-id4.1 tl-id_0 tl-b_0 #f) - (if implicit-omitted?359_0 + (if (let ((mpi_0 + (module-binding-module b_0))) + (begin-unsafe + (eq? + top-level-module-path-index + mpi_0))) + s360_0 + id_0)) + (if (register-eventual-variable!? + id_0 + ctx361_0) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx361_0))) + (parsed-id2.1 id_0 b_0 #f) + id_0) + (if (not + (begin-unsafe + (expand-context/inner-allow-unbound? + (root-expand-context/outer-inner + ctx361_0)))) + (raise-unbound-syntax-error + #f + "unbound identifier" + id_0 + #f + null + (syntax-debug-info-string id_0 ctx361_0)) + (let ((tl-id_0 + (add-scope id_0 - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-s_0) - (syntax-e$1 - disarmed-s_0) - disarmed-s_0))) - (if (pair? s_0) - (let ((|#%top373_0| - (let ((s_1 - (car s_0))) - s_1))) - (let ((id374_0 - (let ((s_1 - (cdr - s_0))) - (if (let ((or-part_0 - (if (syntax?$1 - s_1) - (symbol? - (syntax-e$1 - s_1)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_1))) - s_1 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-s_0 - s_1))))) - (let ((|#%top373_1| - |#%top373_0|)) - (values - |#%top373_1| - id374_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-s_0)))) - (case-lambda - ((|#%top371_0| id372_0) - (values - #t - |#%top371_0| - id372_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 |#%top371_0| id372_0) - (let ((temp376_0 - (cons - |#%top371_0| - id_0))) - (rebuild.1 - #t - s360_0 - temp376_0))) - (args - (raise-binding-result-arity-error - 3 - args)))))) - (if (begin-unsafe - (expand-context/inner-to-parsed? + (begin-unsafe + (root-expand-context/inner-top-level-bind-scope (root-expand-context/outer-inner - ctx361_0))) - (parsed-top-id4.1 id_0 b_0 #f) - s360_0))))))))))))))))) + ctx361_0)))))) + (let ((temp370_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner + ctx361_0))))) + (let ((tl-b_0 + (resolve.1 + #f + #f + null + #f + tl-id_0 + temp370_0))) + (if tl-b_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx361_0))) + (parsed-top-id4.1 + tl-id_0 + tl-b_0 + #f) + (if implicit-omitted?359_0 + id_0 + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-s_0) + (syntax-e$1 + disarmed-s_0) + disarmed-s_0))) + (if (pair? s_0) + (let ((|#%top373_0| + (let ((s_1 + (car + s_0))) + s_1))) + (let ((id374_0 + (let ((s_1 + (cdr + s_0))) + (if (let ((or-part_0 + (if (syntax?$1 + s_1) + (symbol? + (syntax-e$1 + s_1)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_1))) + s_1 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-s_0 + s_1))))) + (let ((|#%top373_1| + |#%top373_0|)) + (values + |#%top373_1| + id374_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-s_0)))) + (case-lambda + ((|#%top371_0| id372_0) + (values + #t + |#%top371_0| + id372_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 |#%top371_0| id372_0) + (let ((temp376_0 + (cons + |#%top371_0| + id_0))) + (rebuild.1 + #t + s360_0 + temp376_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx361_0))) + (parsed-top-id4.1 id_0 b_0 #f) + s360_0))))))))))))))))))) (|#%name| ...nder/expand/expr.rkt:600:1 (case-lambda @@ -83390,7 +81744,7 @@ ctx_0 implicit-omitted?359_0))))))) (void))) -(define effect_2517 +(define effect_2003 (begin (void (add-core-form!* @@ -83498,12 +81852,11 @@ rename-loop (lambda (id_0 from-rename?_0) (begin - (let ((binding_0 - (let ((temp387_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - ctx_0))))) + (let ((temp387_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) + (let ((binding_0 (resolve+shift.1 'ambiguous #f @@ -83511,173 +81864,132 @@ #t #f id_0 - temp387_0)))) - (begin - (if (eq? binding_0 'ambiguous) - (raise-ambiguous-error id_0 ctx_0) - (void)) - (call-with-values - (lambda () - (if binding_0 - (lookup.1 #f #f binding_0 ctx_0 s_0) - (values #f #f #f #f))) - (case-lambda - ((t_0 primitive?_0 insp_0 protected?_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'resolve id_0) - (void))) - (if (let ((or-part_0 (variable? t_0))) - (if or-part_0 - or-part_0 - (if (not binding_0) - (let ((or-part_1 - (register-eventual-variable!? - id_0 - ctx_0))) - (if or-part_1 - or-part_1 - (begin-unsafe - (expand-context/inner-allow-unbound? - (root-expand-context/outer-inner - ctx_0))))) - #f))) - (begin - (if (if (module-binding? binding_0) - (not - (let ((app_0 - (module-binding-module - binding_0))) - (inside-module-context? - app_0 - (begin-unsafe - (root-expand-context/inner-self-mpi - (root-expand-context/outer-inner - ctx_0)))))) - #f) - (raise-syntax-error$1 - #f - "cannot mutate module-required identifier" - s_0 - id_0) - (void)) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe obs_0 'next) - (void))) - (begin - (register-variable-referenced-if-local! - binding_0 - ctx_0) - (let ((rebuild-s_0 - (keep-as-needed.1 - #f - #f - #f - ctx_0 - s_0))) - (let ((exp-rhs_0 - (let ((temp396_0 - (as-expression-context - ctx_0))) - (expand.1 - #f - #f - rhs379_0 - temp396_0)))) - (if (begin-unsafe - (expand-context/inner-to-parsed? + temp387_0))) + (begin + (if (eq? binding_0 'ambiguous) + (raise-ambiguous-error id_0 ctx_0) + (void)) + (call-with-values + (lambda () + (if binding_0 + (lookup.1 #f #f binding_0 ctx_0 s_0) + (values #f #f #f #f))) + (case-lambda + ((t_0 primitive?_0 insp_0 protected?_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'resolve id_0) + (void))) + (if (let ((or-part_0 (variable? t_0))) + (if or-part_0 + or-part_0 + (if (not binding_0) + (let ((or-part_1 + (register-eventual-variable!? + id_0 + ctx_0))) + (if or-part_1 + or-part_1 + (begin-unsafe + (expand-context/inner-allow-unbound? (root-expand-context/outer-inner - ctx_0))) - (parsed-set!9.1 - rebuild-s_0 - (parsed-id2.1 id_0 binding_0 #f) - exp-rhs_0) - (let ((temp398_0 - (list - set!377_0 - (let ((temp401_0 - (free-id-set-empty-or-just-module*? - (begin-unsafe - (expand-context/inner-stops - (root-expand-context/outer-inner - ctx_0)))))) - (substitute-variable.1 - temp401_0 - id_0 - t_0)) - exp-rhs_0))) - (rebuild.1 - #t - rebuild-s_0 - temp398_0)))))))) - (if (not binding_0) - (raise-unbound-syntax-error - #f - "unbound identifier" - s_0 - id_0 - null - (syntax-debug-info-string id_0 ctx_0)) - (if (1/set!-transformer? t_0) - (if (not-in-this-expand-context? - t_0 - ctx_0) - (let ((temp402_0 - (avoid-current-expand-context - (|#%app| - substitute-set!-rename - s_0 - disarmed-s_0 - set!377_0 - rhs379_0 - id_0 - from-rename?_0 - ctx_0) - t_0 - ctx_0))) - (expand.1 #f #f temp402_0 ctx_0)) - (call-with-values - (lambda () - (apply-transformer.1 - id378_0 - t_0 - insp_0 - s_0 - id378_0 - ctx_0 - binding_0)) - (case-lambda - ((exp-s_0 re-ctx_0) - (if (begin-unsafe - (expand-context/inner-just-once? + ctx_0))))) + #f))) + (begin + (if (if (module-binding? binding_0) + (not + (let ((app_0 + (module-binding-module + binding_0))) + (inside-module-context? + app_0 + (begin-unsafe + (root-expand-context/inner-self-mpi + (root-expand-context/outer-inner + ctx_0)))))) + #f) + (raise-syntax-error$1 + #f + "cannot mutate module-required identifier" + s_0 + id_0) + (void)) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer (root-expand-context/outer-inner - ctx_0))) - exp-s_0 - (expand.1 - #f - #f - exp-s_0 - re-ctx_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (if (1/rename-transformer? t_0) + ctx_0))))) + (if obs_0 + (call-expand-observe obs_0 'next) + (void))) + (begin + (register-variable-referenced-if-local! + binding_0 + ctx_0) + (let ((rebuild-s_0 + (keep-as-needed.1 + #f + #f + #f + ctx_0 + s_0))) + (let ((exp-rhs_0 + (let ((temp396_0 + (as-expression-context + ctx_0))) + (expand.1 + #f + #f + rhs379_0 + temp396_0)))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))) + (parsed-set!9.1 + rebuild-s_0 + (parsed-id2.1 + id_0 + binding_0 + #f) + exp-rhs_0) + (let ((temp398_0 + (list + set!377_0 + (let ((temp401_0 + (free-id-set-empty-or-just-module*? + (begin-unsafe + (expand-context/inner-stops + (root-expand-context/outer-inner + ctx_0)))))) + (substitute-variable.1 + temp401_0 + id_0 + t_0)) + exp-rhs_0))) + (rebuild.1 + #t + rebuild-s_0 + temp398_0)))))))) + (if (not binding_0) + (raise-unbound-syntax-error + #f + "unbound identifier" + s_0 + id_0 + null + (syntax-debug-info-string id_0 ctx_0)) + (if (1/set!-transformer? t_0) (if (not-in-this-expand-context? t_0 ctx_0) - (let ((temp413_0 + (let ((temp402_0 (avoid-current-expand-context (|#%app| substitute-set!-rename @@ -83690,22 +82002,66 @@ ctx_0) t_0 ctx_0))) - (expand.1 #f #f temp413_0 ctx_0)) - (rename-loop_0 - (apply-rename-transformer - t_0 - id_0 - ctx_0) - #t)) - (raise-syntax-error$1 - #f - "cannot mutate syntax identifier" - s_0 - id_0))))))) - (args - (raise-binding-result-arity-error - 4 - args))))))))))) + (expand.1 #f #f temp402_0 ctx_0)) + (call-with-values + (lambda () + (apply-transformer.1 + id378_0 + t_0 + insp_0 + s_0 + id378_0 + ctx_0 + binding_0)) + (case-lambda + ((exp-s_0 re-ctx_0) + (if (begin-unsafe + (expand-context/inner-just-once? + (root-expand-context/outer-inner + ctx_0))) + exp-s_0 + (expand.1 + #f + #f + exp-s_0 + re-ctx_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (if (1/rename-transformer? t_0) + (if (not-in-this-expand-context? + t_0 + ctx_0) + (let ((temp413_0 + (avoid-current-expand-context + (|#%app| + substitute-set!-rename + s_0 + disarmed-s_0 + set!377_0 + rhs379_0 + id_0 + from-rename?_0 + ctx_0) + t_0 + ctx_0))) + (expand.1 #f #f temp413_0 ctx_0)) + (rename-loop_0 + (apply-rename-transformer + t_0 + id_0 + ctx_0) + #t)) + (raise-syntax-error$1 + #f + "cannot mutate syntax identifier" + s_0 + id_0))))))) + (args + (raise-binding-result-arity-error + 4 + args)))))))))))) (rename-loop_0 id378_0 #f))) (args (raise-binding-result-arity-error 4 args))))))))) (void))) @@ -83720,7 +82076,7 @@ disarmed-s_0) s_0) s_0))) -(define effect_2816 +(define effect_2374 (begin (void (add-core-form!* @@ -83968,12 +82324,11 @@ ((ok?_2 |#%variable-reference430_0|) (if (if ok?_0 ok?_0 ok?_1) (let ((var-id_0 (if ok?_0 id416_0 id422_0))) - (let ((binding_0 - (let ((temp433_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - ctx_0))))) + (let ((temp433_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner ctx_0))))) + (let ((binding_0 (resolve+shift.1 'ambiguous #f @@ -83981,76 +82336,76 @@ unsafe-undefined #f var-id_0 - temp433_0)))) - (begin - (if (eq? binding_0 'ambiguous) - (raise-ambiguous-error var-id_0 ctx_0) - (void)) + temp433_0))) (begin - (if (if binding_0 - binding_0 - (begin-unsafe - (expand-context/inner-allow-unbound? - (root-expand-context/outer-inner - ctx_0)))) - (void) - (raise-unbound-syntax-error - #f - "unbound identifier" - s_0 - var-id_0 - null - (syntax-debug-info-string var-id_0 ctx_0))) - (call-with-values - (lambda () - (if binding_0 - (let ((temp439_0 - (begin-unsafe - (expand-context/inner-in-local-expand? - (root-expand-context/outer-inner - ctx_0))))) - (lookup.1 - s_0 - temp439_0 + (if (eq? binding_0 'ambiguous) + (raise-ambiguous-error var-id_0 ctx_0) + (void)) + (begin + (if (if binding_0 binding_0 - ctx_0 - var-id_0)) - (values #f #f #f #f))) - (case-lambda - ((t_0 primitive?_0 insp-of-t_0 protected?_0) - (begin - (if (if t_0 (not (variable? t_0)) #f) - (raise-syntax-error$1 - #f - "identifier does not refer to a variable" - var-id_0 - s_0) - (void)) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx_0))) - (|parsed-#%variable-reference11.1| - (begin-unsafe #f) - (if ok?_1 - (parsed-top-id4.1 - var-id_0 - binding_0 - #f) - (if primitive?_0 - (parsed-primitive-id3.1 + (begin-unsafe + (expand-context/inner-allow-unbound? + (root-expand-context/outer-inner + ctx_0)))) + (void) + (raise-unbound-syntax-error + #f + "unbound identifier" + s_0 + var-id_0 + null + (syntax-debug-info-string var-id_0 ctx_0))) + (call-with-values + (lambda () + (if binding_0 + (let ((temp439_0 + (begin-unsafe + (expand-context/inner-in-local-expand? + (root-expand-context/outer-inner + ctx_0))))) + (lookup.1 + s_0 + temp439_0 + binding_0 + ctx_0 + var-id_0)) + (values #f #f #f #f))) + (case-lambda + ((t_0 primitive?_0 insp-of-t_0 protected?_0) + (begin + (if (if t_0 (not (variable? t_0)) #f) + (raise-syntax-error$1 + #f + "identifier does not refer to a variable" + var-id_0 + s_0) + (void)) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx_0))) + (|parsed-#%variable-reference11.1| + (begin-unsafe #f) + (if ok?_1 + (parsed-top-id4.1 var-id_0 binding_0 #f) - (parsed-id2.1 - var-id_0 - binding_0 - #f)))) - s_0))) - (args - (raise-binding-result-arity-error - 4 - args)))))))) + (if primitive?_0 + (parsed-primitive-id3.1 + var-id_0 + binding_0 + #f) + (parsed-id2.1 + var-id_0 + binding_0 + #f)))) + s_0))) + (args + (raise-binding-result-arity-error + 4 + args))))))))) (if (begin-unsafe (expand-context/inner-to-parsed? (root-expand-context/outer-inner ctx_0))) @@ -86253,10 +84608,10 @@ (let ((temp105_0 (if (expand-context/outer? ctx_0) - (let ((inner107_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_0))) + (let ((inner107_0 (if (expand-context/inner? the-struct_0) (let ((stops108_0 @@ -86266,175 +84621,97 @@ (core-id 'begin at-phase_0))))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - stops108_0 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + stops108_0 + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-context - ctx_0))) - (let ((app_4 - (expand-context/outer-env - ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner107_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - #f - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - ctx_0))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner107_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + (root-expand-context/outer-frame-id + ctx_0) + (expand-context/outer-context + ctx_0) + (expand-context/outer-env + ctx_0) + (expand-context/outer-scopes + ctx_0) + #f + (expand-context/outer-binding-layer + ctx_0) + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? + ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name + ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -86923,11 +85200,11 @@ (let ((rest_1 (unsafe-cdr lst_1))) - (let ((result_1 - (let ((result_1 - (let ((id_0 - (required-id - i_0))) + (let ((id_0 + (required-id + i_0))) + (let ((result_1 + (let ((result_1 (let ((phase_0 (required-phase i_0))) @@ -86935,20 +85212,20 @@ id_0 except-id_0 phase_0 - phase_0))))) - (values - result_1)))) - (if (if (not - (let ((x_0 - (list - i_0))) - result_1)) - #t - #f) - (for-loop_1 - result_1 - rest_1) - result_1)))) + phase_0)))) + (values + result_1)))) + (if (if (not + (let ((x_0 + (list + i_0))) + result_1)) + #t + #f) + (for-loop_1 + result_1 + rest_1) + result_1))))) result_0)))))) (for-loop_1 #f @@ -87321,7 +85598,7 @@ "illegal use (not in a module top-level)" s_0))))) (void))) -(define effect_2445 +(define effect_2481 (begin (void (add-core-form!* @@ -87356,172 +85633,71 @@ app_0 s_0 (if (expand-context/outer? ctx_0) - (let ((inner198_0 - (let ((the-struct_0 - (root-expand-context/outer-inner ctx_0))) + (let ((the-struct_0 (root-expand-context/outer-inner ctx_0))) + (let ((inner198_0 (if (expand-context/inner? the-struct_0) - (let ((app_1 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_7 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_8 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_9 - (expand-context/inner-phase - the-struct_0))) - (let ((app_10 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_11 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-stops - the-struct_0))) - (let ((app_16 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_17 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_19 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_22 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_23 - (expand-context/inner-observer - the-struct_0))) - (let ((app_24 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_25 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_26 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_27 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - #f - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - app_27 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter the-struct_0) + (root-expand-context/inner-lift-key the-struct_0) + (expand-context/inner-to-parsed? the-struct_0) + (expand-context/inner-phase the-struct_0) + (expand-context/inner-namespace the-struct_0) + (expand-context/inner-just-once? the-struct_0) + #f + (expand-context/inner-allow-unbound? the-struct_0) + (expand-context/inner-in-local-expand? the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts the-struct_0) + (expand-context/inner-lift-envs the-struct_0) + (expand-context/inner-module-lifts the-struct_0) + (expand-context/inner-require-lifts the-struct_0) + (expand-context/inner-to-module-lifts the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_1 - (root-expand-context/outer-post-expansion ctx_0))) - (let ((app_2 - (root-expand-context/outer-use-site-scopes ctx_0))) - (let ((app_3 (root-expand-context/outer-frame-id ctx_0))) - (let ((app_4 (expand-context/outer-context ctx_0))) - (let ((app_5 (expand-context/outer-env ctx_0))) - (let ((app_6 (expand-context/outer-scopes ctx_0))) - (let ((app_7 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_8 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_9 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_10 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_11 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_12 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_13 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner198_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - (expand-context/outer-name - ctx_0)))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner198_0 + (root-expand-context/outer-post-expansion ctx_0) + (root-expand-context/outer-use-site-scopes ctx_0) + (root-expand-context/outer-frame-id ctx_0) + (expand-context/outer-context ctx_0) + (expand-context/outer-env ctx_0) + (expand-context/outer-scopes ctx_0) + (expand-context/outer-def-ctx-scopes ctx_0) + (expand-context/outer-binding-layer ctx_0) + (expand-context/outer-reference-records ctx_0) + (expand-context/outer-only-immediate? ctx_0) + (expand-context/outer-need-eventually-defined ctx_0) + (expand-context/outer-current-introduction-scopes ctx_0) + (expand-context/outer-current-use-scopes ctx_0) + (expand-context/outer-name ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -87782,2043 +85958,1594 @@ self_0 root-ctx_0 ns215_0))))))) - (let ((m-ns_0 - (let ((temp234_0 - (begin-unsafe - (expand-context/inner-namespace - (root-expand-context/outer-inner - init-ctx14_0))))) + (let ((temp234_0 + (begin-unsafe + (expand-context/inner-namespace + (root-expand-context/outer-inner + init-ctx14_0))))) + (let ((m-ns_0 (make-m-ns_0 unsafe-undefined - temp234_0)))) - (let ((ctx_0 - (let ((v_0 - (copy-root-expand-context - init-ctx14_0 - root-ctx_0))) - (if (expand-context/outer? - v_0) - (let ((post-expansion235_0 - (|#%name| - post-expansion235 - (lambda (s_0) - (begin - (add-scope - s_0 - inside-scope_0)))))) - (let ((inner236_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - v_0))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_9 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_10 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_11 - (expand-context/inner-stops - the-struct_0))) - (let ((app_12 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_13 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_14 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_15 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_16 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_19 - (expand-context/inner-observer - the-struct_0))) - (let ((app_20 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_21 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_22 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_23 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - 0 - m-ns_0 - #f - app_8 - #f - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((post-expansion235_1 - post-expansion235_0)) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - v_0))) - (let ((app_1 - (root-expand-context/outer-frame-id - v_0))) - (let ((app_2 - (expand-context/outer-context - v_0))) - (let ((app_3 - (expand-context/outer-env - v_0))) - (let ((app_4 - (expand-context/outer-scopes - v_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - v_0))) - (let ((app_6 - (expand-context/outer-binding-layer - v_0))) - (let ((app_7 - (expand-context/outer-reference-records - v_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - v_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner236_0 - post-expansion235_1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - v_0))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - v_0))))) - (let ((bodys_0 - (let ((scoped-s_0 - (|#%app| - apply-module-scopes_0 - disarmed-s_0))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 + temp234_0))) + (let ((ctx_0 + (let ((v_0 + (copy-root-expand-context + init-ctx14_0 + root-ctx_0))) + (if (expand-context/outer? + v_0) + (let ((post-expansion235_0 + (|#%name| + post-expansion235 + (lambda (s_0) + (begin + (add-scope + s_0 + inside-scope_0)))))) + (let ((inner236_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + v_0))) + (if (expand-context/inner? + the-struct_0) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + 0 + m-ns_0 + #f + (expand-context/inner-module-begin-k + the-struct_0) + #f + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((post-expansion235_1 + post-expansion235_0)) + (expand-context/outer1.1 + inner236_0 + post-expansion235_1 + (root-expand-context/outer-use-site-scopes + v_0) + (root-expand-context/outer-frame-id + v_0) + (expand-context/outer-context + v_0) + (expand-context/outer-env + v_0) + (expand-context/outer-scopes + v_0) + (expand-context/outer-def-ctx-scopes + v_0) + (expand-context/outer-binding-layer + v_0) + (expand-context/outer-reference-records + v_0) + (expand-context/outer-only-immediate? + v_0) + (expand-context/outer-need-eventually-defined + v_0) + (expand-context/outer-current-introduction-scopes + v_0) + (expand-context/outer-current-use-scopes + v_0) + (expand-context/outer-name + v_0))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + v_0))))) + (let ((bodys_0 + (let ((scoped-s_0 + (|#%app| + apply-module-scopes_0 + disarmed-s_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + scoped-s_0) + (syntax-e$1 scoped-s_0) - (syntax-e$1 - scoped-s_0) - scoped-s_0))) - (if (pair? - s_0) - (let ((_0 + scoped-s_0))) + (if (pair? + s_0) + (let ((_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () (let ((s_1 - (car + (cdr s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((_1 + s_1))) + (if (pair? + s_2) + (let ((_1 + (let ((s_3 + (car + s_2))) + s_3))) + (call-with-values + (lambda () (let ((s_3 - (car + (cdr s_2))) - s_3))) - (call-with-values - (lambda () - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((_2 - (let ((s_5 - (car - s_4))) - s_5))) - (let ((body253_0 + s_3))) + (if (pair? + s_4) + (let ((_2 (let ((s_5 - (cdr + (car s_4))) - (let ((s_6 - (if (syntax?$1 + s_5))) + (let ((body253_0 + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 s_5) - (syntax-e$1 - s_5) - s_5))) - (let ((flat-s_0 - (to-syntax-list.1 - s_6))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - scoped-s_0) - flat-s_0)))))) - (let ((_3 - _2)) - (values - _3 - body253_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - scoped-s_0))))) - (case-lambda - ((_2 - body251_0) - (let ((_3 - _1)) - (values - _3 - _2 - body251_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - scoped-s_0))))) - (case-lambda - ((_1 - _2 - body248_0) - (let ((_3 - _0)) - (values - _3 - _1 + s_5))) + (let ((flat-s_0 + (to-syntax-list.1 + s_6))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + scoped-s_0) + flat-s_0)))))) + (let ((_3 + _2)) + (values + _3 + body253_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + scoped-s_0))))) + (case-lambda + ((_2 + body251_0) + (let ((_3 + _1)) + (values + _3 + _2 + body251_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + scoped-s_0))))) + (case-lambda + ((_1 _2 - body248_0))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - scoped-s_0)))) - (case-lambda - ((_0 - _1 - _2 - body244_0) - (values - #t - _0 - _1 - _2 - body244_0)) - (args - (raise-binding-result-arity-error - 4 - args))))) - (case-lambda - ((ok?_1 - _0 - _1 - _2 - body244_0) - body244_0) - (args - (raise-binding-result-arity-error - 5 - args))))))) - (let ((requires+provides_0 - (make-requires+provides.1 - #f - self_0))) - (let ((defined-syms_0 - (begin-unsafe - (root-expand-context/inner-defined-syms - (root-expand-context/outer-inner - root-ctx_0))))) - (let ((compiled-submodules_0 - (make-hasheq))) - (let ((compiled-module-box_0 - (box #f))) - (let ((mpis-to-reset_0 - (box null))) - (let ((initial-require!_0 - (|#%name| - initial-require! - (lambda (bind?217_0) - (begin - (if (not - keep-enclosing-scope-at-phase2_0) - (let ((requires+provides259_0 - requires+provides_0)) - (perform-initial-require!.1 - bind?217_0 - 'module - initial-require_0 - self_0 - initial-require-s_0 - m-ns_0 - requires+provides259_0)) - (begin - (add-required-module! - requires+provides_0 - enclosing-mod_0 - keep-enclosing-scope-at-phase2_0 - enclosing-is-cross-phase-persistent?3_0) - (let ((requires+provides262_0 + body248_0) + (let ((_3 + _0)) + (values + _3 + _1 + _2 + body248_0))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + scoped-s_0)))) + (case-lambda + ((_0 + _1 + _2 + body244_0) + (values + #t + _0 + _1 + _2 + body244_0)) + (args + (raise-binding-result-arity-error + 4 + args))))) + (case-lambda + ((ok?_1 + _0 + _1 + _2 + body244_0) + body244_0) + (args + (raise-binding-result-arity-error + 5 + args))))))) + (let ((requires+provides_0 + (make-requires+provides.1 + #f + self_0))) + (let ((defined-syms_0 + (begin-unsafe + (root-expand-context/inner-defined-syms + (root-expand-context/outer-inner + root-ctx_0))))) + (let ((compiled-submodules_0 + (make-hasheq))) + (let ((compiled-module-box_0 + (box #f))) + (let ((mpis-to-reset_0 + (box + null))) + (let ((initial-require!_0 + (|#%name| + initial-require! + (lambda (bind?217_0) + (begin + (if (not + keep-enclosing-scope-at-phase2_0) + (let ((requires+provides259_0 requires+provides_0)) - (add-enclosing-module-defined-and-required!.1 - enclosing-requires+provides4_0 - requires+provides262_0 - enclosing-mod_0 - keep-enclosing-scope-at-phase2_0)) - (namespace-module-visit!.1 - unsafe-undefined - m-ns_0 - enclosing-mod_0 - keep-enclosing-scope-at-phase2_0)))))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - init-ctx14_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prepare-env) - (void))) - (begin - (initial-require!_0 - #t) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - init-ctx14_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'rename-one - bodys_0) - (void))) - (let ((again?_0 - #f)) - (letrec* - ((module-begin-k_0 - (|#%name| - module-begin-k - (lambda (mb-s_0 - mb-init-ctx_0) + (perform-initial-require!.1 + bind?217_0 + 'module + initial-require_0 + self_0 + initial-require-s_0 + m-ns_0 + requires+provides259_0)) (begin + (add-required-module! + requires+provides_0 + enclosing-mod_0 + keep-enclosing-scope-at-phase2_0 + enclosing-is-cross-phase-persistent?3_0) + (let ((requires+provides262_0 + requires+provides_0)) + (add-enclosing-module-defined-and-required!.1 + enclosing-requires+provides4_0 + requires+provides262_0 + enclosing-mod_0 + keep-enclosing-scope-at-phase2_0)) + (namespace-module-visit!.1 + unsafe-undefined + m-ns_0 + enclosing-mod_0 + keep-enclosing-scope-at-phase2_0)))))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + init-ctx14_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (begin + (initial-require!_0 + #t) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + init-ctx14_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'rename-one + bodys_0) + (void))) + (let ((again?_0 + #f)) + (letrec* + ((module-begin-k_0 + (|#%name| + module-begin-k + (lambda (mb-s_0 + mb-init-ctx_0) (begin - (if again?_0 - (begin - (requires+provides-reset! - requires+provides_0) - (initial-require!_0 - #f) - (hash-clear! - compiled-submodules_0) - (set-box! - compiled-module-box_0 - #f)) - (void)) (begin - (set! again?_0 - #t) - (let ((ctx_1 - (if (expand-context/outer? - mb-init-ctx_0) - (let ((post-expansion274_0 - (|#%name| - post-expansion274 - (lambda (s_0) - (begin - (add-scope - s_0 - inside-scope_0)))))) - (let ((inner275_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - mb-init-ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((module-begin-k276_0 - (|#%name| - module-begin-k276 - (lambda (s_0 - ctx_1) - (begin - (let ((new-requires+provides_0 - (let ((requires+provides286_0 - requires+provides_0)) - (make-requires+provides.1 - requires+provides286_0 - self_0)))) - (let ((requires+provides277_0 - requires+provides_0)) - (let ((compiled-submodules278_0 - compiled-submodules_0)) - (let ((compiled-module-box279_0 - compiled-module-box_0)) - (let ((defined-syms280_0 - defined-syms_0)) - (let ((compiled-submodules282_0 - (make-hasheq))) - (let ((compiled-module-box283_0 - (box - #f))) - (let ((defined-syms284_0 - (make-hasheq))) - (let ((compiled-module-box283_1 - compiled-module-box283_0) - (compiled-submodules282_1 - compiled-submodules282_0) - (defined-syms280_1 - defined-syms280_0) - (compiled-module-box279_1 - compiled-module-box279_0) - (compiled-submodules278_1 - compiled-submodules278_0) - (requires+provides277_1 - requires+provides277_0)) - (dynamic-wind - (lambda () - (begin - (set! requires+provides_0 - new-requires+provides_0) - (set! compiled-submodules_0 - compiled-submodules282_1) - (set! compiled-module-box_0 - compiled-module-box283_1) - (set! defined-syms_0 - defined-syms284_0))) - (lambda () - (module-begin-k_0 - s_0 - ctx_1)) - (lambda () - (begin - (set! requires+provides_0 - requires+provides277_1) - (set! compiled-submodules_0 - compiled-submodules278_1) - (set! compiled-module-box_0 - compiled-module-box279_1) - (set! defined-syms_0 - defined-syms280_1)))))))))))))))))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - module-begin-k276_0 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((post-expansion274_1 - post-expansion274_0)) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - mb-init-ctx_0))) - (let ((app_1 - (root-expand-context/outer-frame-id - mb-init-ctx_0))) - (let ((app_2 - (expand-context/outer-context - mb-init-ctx_0))) - (let ((app_3 - (expand-context/outer-env - mb-init-ctx_0))) - (let ((app_4 - (expand-context/outer-scopes - mb-init-ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - mb-init-ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - mb-init-ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - mb-init-ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - mb-init-ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - mb-init-ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - mb-init-ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - mb-init-ctx_0))) - (expand-context/outer1.1 - inner275_0 - post-expansion274_1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - mb-init-ctx_0))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - mb-init-ctx_0)))) - (let ((added-s_0 - (add-scope - mb-s_0 - inside-scope_0))) - (let ((disarmed-mb-s_0 - (syntax-disarm$1 - added-s_0))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-mb-s_0) - (syntax-e$1 - disarmed-mb-s_0) - disarmed-mb-s_0))) - (if (pair? - s_0) - (let ((|#%module-begin271_0| - (let ((s_1 - (car - s_0))) - s_1))) - (let ((body272_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-mb-s_0) - flat-s_0)))))) - (let ((|#%module-begin271_1| - |#%module-begin271_0|)) - (values - |#%module-begin271_1| - body272_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-mb-s_0)))) - (case-lambda - ((|#%module-begin269_0| - body270_0) - (values - #t - |#%module-begin269_0| - body270_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_1 - |#%module-begin269_0| - body270_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'rename-one - added-s_0) - (void))) - (let ((rebuild-mb-s_0 - (keep-as-needed.1 - #f - #f - #f - ctx_1 - mb-s_0))) - (let ((need-eventually-defined_0 - (make-hasheqv))) - (let ((module-ends_0 - (make-shared-module-ends))) - (let ((declared-keywords_0 - (make-hasheq))) - (let ((declared-submodule-names_0 - (make-hasheq))) - (let ((expression-expanded-bodys_0 - (letrec* - ((pass-1-and-2-loop_0 + (if again?_0 + (begin + (requires+provides-reset! + requires+provides_0) + (initial-require!_0 + #f) + (hash-clear! + compiled-submodules_0) + (set-box! + compiled-module-box_0 + #f)) + (void)) + (begin + (set! again?_0 + #t) + (let ((ctx_1 + (if (expand-context/outer? + mb-init-ctx_0) + (let ((post-expansion274_0 + (|#%name| + post-expansion274 + (lambda (s_0) + (begin + (add-scope + s_0 + inside-scope_0)))))) + (let ((inner275_0 + (let ((the-struct_0 + (root-expand-context/outer-inner + mb-init-ctx_0))) + (if (expand-context/inner? + the-struct_0) + (let ((module-begin-k276_0 (|#%name| - pass-1-and-2-loop - (lambda (bodys_1 - phase_0 - keep-stops?_0) + module-begin-k276 + (lambda (s_0 + ctx_1) (begin - (let ((def-ctx-scopes_0 - (box - null))) - (let ((partial-body-ctx_0 - (if (expand-context/outer? - ctx_1) - (let ((inner300_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_1))) - (if (expand-context/inner? - the-struct_0) - (let ((namespace302_0 - (namespace->namespace-at-phase - m-ns_0 - phase_0))) - (let ((stops303_0 - (free-id-set - phase_0 - (module-expand-stop-ids - phase_0)))) - (let ((lift-key305_0 - (generate-lift-key))) - (let ((lifts306_0 - (let ((temp310_0 - (let ((app_0 - defined-syms_0)) - (make-wrap-as-definition - self_0 - frame-id_0 - inside-scope_0 - initial-require-s_0 - app_0 - requires+provides_0)))) - (make-lift-context.1 - #f - temp310_0)))) - (let ((module-lifts307_0 - (begin-unsafe - (module-lift-context15.1 - phase_0 - (box - null) - #t)))) - (let ((require-lifts308_0 - (let ((do-require_0 - (let ((requires+provides313_0 - requires+provides_0)) - (make-parse-lifted-require.1 - declared-submodule-names_0 - m-ns_0 - self_0 - requires+provides313_0)))) + (let ((new-requires+provides_0 + (let ((requires+provides286_0 + requires+provides_0)) + (make-requires+provides.1 + requires+provides286_0 + self_0)))) + (let ((requires+provides277_0 + requires+provides_0)) + (let ((compiled-submodules278_0 + compiled-submodules_0)) + (let ((compiled-module-box279_0 + compiled-module-box_0)) + (let ((defined-syms280_0 + defined-syms_0)) + (let ((compiled-submodules282_0 + (make-hasheq))) + (let ((compiled-module-box283_0 + (box + #f))) + (let ((defined-syms284_0 + (make-hasheq))) + (let ((compiled-module-box283_1 + compiled-module-box283_0) + (compiled-submodules282_1 + compiled-submodules282_0) + (defined-syms280_1 + defined-syms280_0) + (compiled-module-box279_1 + compiled-module-box279_0) + (compiled-submodules278_1 + compiled-submodules278_0) + (requires+provides277_1 + requires+provides277_0)) + (dynamic-wind + (lambda () + (begin + (set! requires+provides_0 + new-requires+provides_0) + (set! compiled-submodules_0 + compiled-submodules282_1) + (set! compiled-module-box_0 + compiled-module-box283_1) + (set! defined-syms_0 + defined-syms284_0))) + (lambda () + (module-begin-k_0 + s_0 + ctx_1)) + (lambda () + (begin + (set! requires+provides_0 + requires+provides277_1) + (set! compiled-submodules_0 + compiled-submodules278_1) + (set! compiled-module-box_0 + compiled-module-box279_1) + (set! defined-syms_0 + defined-syms280_1)))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + module-begin-k276_0 + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0))))) + (let ((post-expansion274_1 + post-expansion274_0)) + (expand-context/outer1.1 + inner275_0 + post-expansion274_1 + (root-expand-context/outer-use-site-scopes + mb-init-ctx_0) + (root-expand-context/outer-frame-id + mb-init-ctx_0) + (expand-context/outer-context + mb-init-ctx_0) + (expand-context/outer-env + mb-init-ctx_0) + (expand-context/outer-scopes + mb-init-ctx_0) + (expand-context/outer-def-ctx-scopes + mb-init-ctx_0) + (expand-context/outer-binding-layer + mb-init-ctx_0) + (expand-context/outer-reference-records + mb-init-ctx_0) + (expand-context/outer-only-immediate? + mb-init-ctx_0) + (expand-context/outer-need-eventually-defined + mb-init-ctx_0) + (expand-context/outer-current-introduction-scopes + mb-init-ctx_0) + (expand-context/outer-current-use-scopes + mb-init-ctx_0) + (expand-context/outer-name + mb-init-ctx_0))))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + mb-init-ctx_0)))) + (let ((added-s_0 + (add-scope + mb-s_0 + inside-scope_0))) + (let ((disarmed-mb-s_0 + (syntax-disarm$1 + added-s_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-mb-s_0) + (syntax-e$1 + disarmed-mb-s_0) + disarmed-mb-s_0))) + (if (pair? + s_0) + (let ((|#%module-begin271_0| + (let ((s_1 + (car + s_0))) + s_1))) + (let ((body272_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-mb-s_0) + flat-s_0)))))) + (let ((|#%module-begin271_1| + |#%module-begin271_0|)) + (values + |#%module-begin271_1| + body272_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-mb-s_0)))) + (case-lambda + ((|#%module-begin269_0| + body270_0) + (values + #t + |#%module-begin269_0| + body270_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_1 + |#%module-begin269_0| + body270_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'rename-one + added-s_0) + (void))) + (let ((rebuild-mb-s_0 + (keep-as-needed.1 + #f + #f + #f + ctx_1 + mb-s_0))) + (let ((need-eventually-defined_0 + (make-hasheqv))) + (let ((module-ends_0 + (make-shared-module-ends))) + (let ((declared-keywords_0 + (make-hasheq))) + (let ((declared-submodule-names_0 + (make-hasheq))) + (let ((expression-expanded-bodys_0 + (letrec* + ((pass-1-and-2-loop_0 + (|#%name| + pass-1-and-2-loop + (lambda (bodys_1 + phase_0 + keep-stops?_0) + (begin + (let ((def-ctx-scopes_0 + (box + null))) + (let ((partial-body-ctx_0 + (if (expand-context/outer? + ctx_1) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_1))) + (let ((inner300_0 + (if (expand-context/inner? + the-struct_0) + (let ((namespace302_0 + (namespace->namespace-at-phase + m-ns_0 + phase_0))) + (let ((stops303_0 + (free-id-set + phase_0 + (module-expand-stop-ids + phase_0)))) + (let ((lift-key305_0 + (generate-lift-key))) + (let ((lifts306_0 + (let ((temp310_0 + (let ((app_0 + defined-syms_0)) + (make-wrap-as-definition + self_0 + frame-id_0 + inside-scope_0 + initial-require-s_0 + app_0 + requires+provides_0)))) + (make-lift-context.1 + #f + temp310_0)))) + (let ((module-lifts307_0 + (begin-unsafe + (module-lift-context15.1 + phase_0 + (box + null) + #t)))) + (let ((require-lifts308_0 + (let ((do-require_0 + (let ((requires+provides313_0 + requires+provides_0)) + (make-parse-lifted-require.1 + declared-submodule-names_0 + m-ns_0 + self_0 + requires+provides313_0)))) + (begin-unsafe + (require-lift-context16.1 + do-require_0 + phase_0 + (box + null)))))) + (let ((to-module-lifts309_0 + (make-to-module-lift-context.1 + #f + module-ends_0 + phase_0))) + (let ((require-lifts308_1 + require-lifts308_0) + (module-lifts307_1 + module-lifts307_0) + (lifts306_1 + lifts306_0) + (lift-key305_1 + lift-key305_0) + (stops303_1 + stops303_0) + (namespace302_1 + namespace302_0)) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + lift-key305_1 + (expand-context/inner-to-parsed? + the-struct_0) + phase_0 + namespace302_1 + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + stops303_1 + declared-submodule-names_0 + lifts306_1 + (expand-context/inner-lift-envs + the-struct_0) + module-lifts307_1 + require-lifts308_1 + to-module-lifts309_0 + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)))))))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0)))) + (expand-context/outer1.1 + inner300_0 + (root-expand-context/outer-post-expansion + ctx_1) + (root-expand-context/outer-use-site-scopes + ctx_1) + (root-expand-context/outer-frame-id + ctx_1) + 'module + (expand-context/outer-env + ctx_1) + (expand-context/outer-scopes + ctx_1) + def-ctx-scopes_0 + (expand-context/outer-binding-layer + ctx_1) + (expand-context/outer-reference-records + ctx_1) + (expand-context/outer-only-immediate? + ctx_1) + need-eventually-defined_0 + (expand-context/outer-current-introduction-scopes + ctx_1) + (expand-context/outer-current-use-scopes + ctx_1) + (expand-context/outer-name + ctx_1)))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_1)))) + (let ((partially-expanded-bodys_0 + (let ((requires+provides324_0 + requires+provides_0)) + (let ((defined-syms327_0 + defined-syms_0)) + (let ((compiled-submodules330_0 + compiled-submodules_0)) + (let ((defined-syms327_1 + defined-syms327_0) + (requires+provides324_1 + requires+provides324_0)) + (partially-expand-bodys.1 + initial-require-s_0 + compiled-submodules330_0 + partial-body-ctx_0 + declared-keywords_0 + declared-submodule-names_0 + defined-syms327_1 + frame-id_0 + pass-1-and-2-loop_0 + modules-being-compiled_0 + mpis-to-reset_0 + m-ns_0 + need-eventually-defined_0 + phase_0 + requires+provides324_1 + self_0 + bodys_1))))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + partial-body-ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (let ((body-ctx_0 + (let ((v_0 + (accumulate-def-ctx-scopes + partial-body-ctx_0 + def-ctx-scopes_0))) + (if (expand-context/outer? + v_0) + (let ((the-struct_0 + (root-expand-context/outer-inner + v_0))) + (let ((inner336_0 + (if (expand-context/inner? + the-struct_0) + (let ((stops337_0 + (if keep-stops?_0 (begin-unsafe - (require-lift-context16.1 - do-require_0 - phase_0 - (box - null)))))) - (let ((to-module-lifts309_0 + (expand-context/inner-stops + (root-expand-context/outer-inner + ctx_1))) + empty-free-id-set))) + (let ((to-module-lifts338_0 (make-to-module-lift-context.1 - #f + #t module-ends_0 phase_0))) - (let ((require-lifts308_1 - require-lifts308_0) - (module-lifts307_1 - module-lifts307_0) - (lifts306_1 - lifts306_0) - (lift-key305_1 - lift-key305_0) - (stops303_1 - stops303_0) - (namespace302_1 - namespace302_0)) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_7 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_8 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_9 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_10 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_11 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_12 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_13 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_14 - (expand-context/inner-observer - the-struct_0))) - (let ((app_15 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_16 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_17 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_18 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - lift-key305_1 - app_6 - phase_0 - namespace302_1 - app_7 - app_8 - app_9 - app_10 - app_11 - stops303_1 - declared-submodule-names_0 - lifts306_1 - app_12 - module-lifts307_1 - require-lifts308_1 - to-module-lifts309_0 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_1))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_1))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_1))) - (let ((app_3 + (let ((stops337_1 + stops337_0)) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + stops337_1 + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + to-module-lifts338_0 + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))))) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0)))) + (expand-context/outer1.1 + inner336_0 + #f + (root-expand-context/outer-use-site-scopes + v_0) + (root-expand-context/outer-frame-id + v_0) + (expand-context/outer-context + v_0) (expand-context/outer-env - ctx_1))) - (let ((app_4 - (expand-context/outer-scopes - ctx_1))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx_1))) - (let ((app_6 - (expand-context/outer-reference-records - ctx_1))) - (let ((app_7 - (expand-context/outer-only-immediate? - ctx_1))) - (let ((app_8 - (expand-context/outer-current-introduction-scopes - ctx_1))) - (let ((app_9 - (expand-context/outer-current-use-scopes - ctx_1))) - (expand-context/outer1.1 - inner300_0 - app_0 - app_1 - app_2 - 'module - app_3 - app_4 - def-ctx-scopes_0 - app_5 - app_6 - app_7 - need-eventually-defined_0 - app_8 - app_9 - (expand-context/outer-name - ctx_1))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_1)))) - (let ((partially-expanded-bodys_0 - (let ((requires+provides324_0 - requires+provides_0)) - (let ((defined-syms327_0 - defined-syms_0)) - (let ((compiled-submodules330_0 - compiled-submodules_0)) - (let ((defined-syms327_1 - defined-syms327_0) - (requires+provides324_1 - requires+provides324_0)) - (partially-expand-bodys.1 - initial-require-s_0 - compiled-submodules330_0 - partial-body-ctx_0 - declared-keywords_0 - declared-submodule-names_0 - defined-syms327_1 - frame-id_0 - pass-1-and-2-loop_0 - modules-being-compiled_0 - mpis-to-reset_0 - m-ns_0 - need-eventually-defined_0 - phase_0 - requires+provides324_1 - self_0 - bodys_1))))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - partial-body-ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (let ((body-ctx_0 - (let ((v_0 - (accumulate-def-ctx-scopes - partial-body-ctx_0 - def-ctx-scopes_0))) - (if (expand-context/outer? - v_0) - (let ((inner336_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - v_0))) - (if (expand-context/inner? - the-struct_0) - (let ((stops337_0 - (if keep-stops?_0 - (begin-unsafe - (expand-context/inner-stops - (root-expand-context/outer-inner - ctx_1))) - empty-free-id-set))) - (let ((to-module-lifts338_0 - (make-to-module-lift-context.1 - #t - module-ends_0 - phase_0))) - (let ((stops337_1 - stops337_0)) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_21 - (expand-context/inner-observer - the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_25 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - stops337_1 - app_15 - app_16 - app_17 - app_18 - app_19 - to-module-lifts338_0 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - v_0))) - (let ((app_1 - (root-expand-context/outer-frame-id - v_0))) - (let ((app_2 - (expand-context/outer-context - v_0))) - (let ((app_3 - (expand-context/outer-env - v_0))) - (let ((app_4 - (expand-context/outer-scopes - v_0))) - (let ((app_5 - (expand-context/outer-binding-layer - v_0))) - (let ((app_6 - (expand-context/outer-reference-records - v_0))) - (let ((app_7 - (expand-context/outer-only-immediate? - v_0))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_10 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner336_0 - #f - app_0 - app_1 - app_2 - app_3 - app_4 - #f - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - v_0)))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - v_0))))) - (let ((compiled-submodules294_0 - compiled-submodules_0)) - (finish-expanding-body-expressions.1 - compiled-submodules294_0 - body-ctx_0 - declared-submodule-names_0 - modules-being-compiled_0 - mpis-to-reset_0 - phase_0 - self_0 - partially-expanded-bodys_0)))))))))))) - (pass-1-and-2-loop_0 - body270_0 - 0 - (stop-at-module*? - ctx_1))))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) + v_0) + (expand-context/outer-scopes + v_0) + #f + (expand-context/outer-binding-layer + v_0) + (expand-context/outer-reference-records + v_0) + (expand-context/outer-only-immediate? + v_0) + (expand-context/outer-need-eventually-defined + v_0) + (expand-context/outer-current-introduction-scopes + v_0) + (expand-context/outer-current-use-scopes + v_0) + (expand-context/outer-name + v_0)))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + v_0))))) + (let ((compiled-submodules294_0 + compiled-submodules_0)) + (finish-expanding-body-expressions.1 + compiled-submodules294_0 + body-ctx_0 + declared-submodule-names_0 + modules-being-compiled_0 + mpis-to-reset_0 + phase_0 + self_0 + partially-expanded-bodys_0)))))))))))) + (pass-1-and-2-loop_0 + body270_0 + 0 + (stop-at-module*? + ctx_1))))) (begin - (check-defined-by-now - need-eventually-defined_0 - self_0 - ctx_1 - requires+provides_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (let ((fully-expanded-bodys-except-post-submodules_0 - (let ((requires+provides343_0 - requires+provides_0)) - (resolve-provides.1 - ctx_1 - declared-submodule-names_0 - m-ns_0 - 0 - requires+provides343_0 - self_0 - expression-expanded-bodys_0)))) - (let ((is-cross-phase-persistent?_0 - (hash-ref - declared-keywords_0 - kw2208 - #f))) - (begin - (if is-cross-phase-persistent?_0 - (begin - (if (requires+provides-can-cross-phase-persistent? - requires+provides_0) - (void) - (raise-syntax-error$1 - #f - "cannot be cross-phase persistent due to required modules" - rebuild-s_0 - (hash-ref - declared-keywords_0 - kw2208))) - (check-cross-phase-persistent-form - fully-expanded-bodys-except-post-submodules_0 - self_0)) - (void)) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_1))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (let ((submod-m-ns_0 - (make-m-ns_0 - #t - m-ns_0))) - (let ((submod-ctx_0 - (if (expand-context/outer? - ctx_1) - (let ((inner353_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_1))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - submod-m-ns_0 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - ctx_1))) - (let ((app_1 - (expand-context/outer-context - ctx_1))) - (let ((app_2 - (expand-context/outer-env - ctx_1))) - (let ((app_3 - (expand-context/outer-scopes - ctx_1))) - (let ((app_4 - (expand-context/outer-def-ctx-scopes - ctx_1))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx_1))) - (let ((app_6 - (expand-context/outer-reference-records - ctx_1))) - (let ((app_7 - (expand-context/outer-only-immediate? - ctx_1))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - ctx_1))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - ctx_1))) - (let ((app_10 - (expand-context/outer-current-use-scopes - ctx_1))) - (expand-context/outer1.1 - inner353_0 - #f - app_0 - #f - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - ctx_1)))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_1)))) - (let ((declare-enclosing-module_0 - (promise1.1 - (lambda () - (let ((requires+provides358_0 - requires+provides_0)) - (let ((compiled-module-box365_0 - compiled-module-box_0)) - (let ((requires+provides358_1 - requires+provides358_0)) - (declare-module-for-expansion.1 - submod-ctx_0 - enclosing-self15_0 - compiled-module-box365_0 - id:module-name201_0 - modules-being-compiled_0 - submod-m-ns_0 - rebuild-s_0 - requires+provides358_1 - root-ctx_0 - self_0 - fully-expanded-bodys-except-post-submodules_0))))) - #f))) - (let ((fully-expanded-bodys_0 - (if (stop-at-module*? - submod-ctx_0) - fully-expanded-bodys-except-post-submodules_0 - (let ((requires+provides370_0 - requires+provides_0)) - (let ((compiled-submodules375_0 - compiled-submodules_0)) - (let ((requires+provides370_1 - requires+provides370_0)) - (expand-post-submodules.1 - initial-require-s_0 - compiled-submodules375_0 - submod-ctx_0 - declare-enclosing-module_0 - declared-submodule-names_0 - is-cross-phase-persistent?_0 - modules-being-compiled_0 - mpis-to-reset_0 - 0 - requires+provides370_1 - self_0 - fully-expanded-bodys-except-post-submodules_0))))))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - submod-ctx_0))) - (|parsed-#%module-begin24.1| - rebuild-mb-s_0 - (parsed-only - fully-expanded-bodys_0)) - (let ((mb-result-s_0 - (let ((temp379_0 - (list* - |#%module-begin269_0| - (syntax-only - fully-expanded-bodys_0)))) - (rebuild.1 - #t - rebuild-mb-s_0 - temp379_0)))) - (if (not - (begin-unsafe - (expand-context/inner-in-local-expand? - (root-expand-context/outer-inner - submod-ctx_0)))) - (expanded+parsed1.1 - mb-result-s_0 - (|parsed-#%module-begin24.1| - rebuild-mb-s_0 - (parsed-only - fully-expanded-bodys_0))) - mb-result-s_0)))))))))))))))))))))) - (args - (raise-binding-result-arity-error - 3 - args)))))))))))))) - (let ((mb-ctx_0 - (if (expand-context/outer? - ctx_0) - (let ((inner381_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx_0))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_13 - (expand-context/inner-stops - the-struct_0))) - (let ((app_14 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_15 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_16 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_17 - (expand-context/inner-observer - the-struct_0))) - (let ((app_18 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_20 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_21 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - module-begin-k_0 - app_11 - #f - app_12 - app_13 - app_14 - #f - app_15 - #f - #f - #f - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - (expand-context/inner-skip-visit-available? - the-struct_0)))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx_0))) - (let ((app_3 - (expand-context/outer-env - ctx_0))) - (let ((app_4 - (expand-context/outer-scopes - ctx_0))) - (let ((app_5 - (expand-context/outer-def-ctx-scopes - ctx_0))) - (let ((app_6 - (expand-context/outer-binding-layer - ctx_0))) - (let ((app_7 - (expand-context/outer-reference-records - ctx_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - ctx_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - ctx_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx_0))) - (expand-context/outer1.1 - inner381_0 - app_0 - app_1 - app_2 - 'module-begin - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - ctx_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx_0)))) - (let ((mb-scopes-s_0 - (if keep-enclosing-scope-at-phase2_0 - (|#%app| - apply-module-scopes_0 - disarmed-s_0) - initial-require-s_0))) - (let ((mb-def-ctx-scopes_0 - (box - null))) - (let ((mb_0 - (ensure-module-begin.1 - mb-ctx_0 - mb-def-ctx-scopes_0 - m-ns_0 - module-name-sym_0 - 0 - s13_0 - mb-scopes-s_0 - bodys_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next) - (void))) - (let ((expanded-mb_0 - (begin - (if log-performance? - (start-performance-region - 'expand - 'module-begin) - (void)) - (begin0 - (let ((temp397_0 - (let ((v_0 - (accumulate-def-ctx-scopes - mb-ctx_0 - mb-def-ctx-scopes_0))) - (if (expand-context/outer? - v_0) - (let ((inner399_0 - (root-expand-context/outer-inner - v_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - v_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - v_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - v_0))) - (let ((app_3 - (expand-context/outer-context - v_0))) - (let ((app_4 - (expand-context/outer-env - v_0))) - (let ((app_5 - (expand-context/outer-scopes - v_0))) - (let ((app_6 - (expand-context/outer-binding-layer - v_0))) - (let ((app_7 - (expand-context/outer-reference-records - v_0))) - (let ((app_8 - (expand-context/outer-only-immediate? - v_0))) - (let ((app_9 - (expand-context/outer-need-eventually-defined - v_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - v_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - v_0))) - (expand-context/outer1.1 - inner399_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - #f - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - (expand-context/outer-name - v_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - v_0))))) - (expand.1 - #f - #f - mb_0 - temp397_0)) - (if log-performance? - (end-performance-region) - (void)))))) - (call-with-values - (lambda () - (extract-requires-and-provides - requires+provides_0 - self_0 - self_0)) - (case-lambda - ((requires_0 - provides_0) - (let ((result-form_0 - (if (let ((or-part_0 - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - init-ctx14_0))))) - (if or-part_0 - or-part_0 - always-produce-compiled?1_0)) - (let ((app_0 - (requires+provides-all-bindings-simple? - requires+provides_0))) - (let ((app_1 - (root-expand-context-encode-for-module - root-ctx_0 - self_0 - self_0))) - (let ((app_2 - (|parsed-#%module-begin-body| - (if (expanded+parsed? - expanded-mb_0) - (expanded+parsed-parsed - expanded-mb_0) - expanded-mb_0)))) - (let ((app_3 - (unbox - compiled-module-box_0))) - (parsed-module25.1 - rebuild-s_0 - #f - id:module-name201_0 - self_0 - requires_0 - provides_0 - app_0 - app_1 - app_2 - app_3 - compiled-submodules_0))))) - #f))) - (let ((result-s_0 - (if (not - (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - init-ctx14_0)))) - (let ((generic-self_0 - (make-generic-self-module-path-index - self_0))) - (begin - (imitate-generic-module-path-index! - self_0) - (let ((lst_0 - (unbox - mpis-to-reset_0))) - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_1) + (check-defined-by-now + need-eventually-defined_0 + self_0 + ctx_1 + requires+provides_0) (begin - (if (pair? - lst_1) - (let ((mpi_0 - (unsafe-car - lst_1))) - (let ((rest_0 - (unsafe-cdr - lst_1))) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (let ((fully-expanded-bodys-except-post-submodules_0 + (let ((requires+provides343_0 + requires+provides_0)) + (resolve-provides.1 + ctx_1 + declared-submodule-names_0 + m-ns_0 + 0 + requires+provides343_0 + self_0 + expression-expanded-bodys_0)))) + (let ((is-cross-phase-persistent?_0 + (hash-ref + declared-keywords_0 + kw2208 + #f))) + (begin + (if is-cross-phase-persistent?_0 + (begin + (if (requires+provides-can-cross-phase-persistent? + requires+provides_0) + (void) + (raise-syntax-error$1 + #f + "cannot be cross-phase persistent due to required modules" + rebuild-s_0 + (hash-ref + declared-keywords_0 + kw2208))) + (check-cross-phase-persistent-form + fully-expanded-bodys-except-post-submodules_0 + self_0)) + (void)) (begin - (imitate-generic-module-path-index! - mpi_0) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - lst_0)))) - (void) - (let ((result-s_0 - (let ((temp401_0 - (list - module200_0 - id:module-name201_0 - initial-require-s_0 - (expanded+parsed-s - expanded-mb_0)))) - (rebuild.1 - #t - rebuild-s_0 - temp401_0)))) - (let ((result-s_1 - (syntax-module-path-index-shift.1 - #f - result-s_0 - self_0 - generic-self_0 - #f))) - (let ((result-s_2 - (attach-root-expand-context-properties - result-s_1 - root-ctx_0 - self_0 - generic-self_0))) - (let ((result-s_3 - (if (requires+provides-all-bindings-simple? - requires+provides_0) - (syntax-property$1 - result-s_2 - 'module-body-context-simple? - #t) - result-s_2))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - init-ctx14_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'rename-one - result-s_3) - (void))) - result-s_3))))))) - (void)))) - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - init-ctx14_0))) - result-form_0 - (if always-produce-compiled?1_0 - (expanded+parsed1.1 - result-s_0 - result-form_0) - result-s_0))))) - (args - (raise-binding-result-arity-error - 2 - args)))))))))))))))))))))))))))))))))))))))) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_1))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (let ((submod-m-ns_0 + (make-m-ns_0 + #t + m-ns_0))) + (let ((submod-ctx_0 + (if (expand-context/outer? + ctx_1) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_1))) + (let ((inner353_0 + (if (expand-context/inner? + the-struct_0) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + submod-m-ns_0 + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0)))) + (expand-context/outer1.1 + inner353_0 + #f + (root-expand-context/outer-use-site-scopes + ctx_1) + #f + (expand-context/outer-context + ctx_1) + (expand-context/outer-env + ctx_1) + (expand-context/outer-scopes + ctx_1) + (expand-context/outer-def-ctx-scopes + ctx_1) + (expand-context/outer-binding-layer + ctx_1) + (expand-context/outer-reference-records + ctx_1) + (expand-context/outer-only-immediate? + ctx_1) + (expand-context/outer-need-eventually-defined + ctx_1) + (expand-context/outer-current-introduction-scopes + ctx_1) + (expand-context/outer-current-use-scopes + ctx_1) + (expand-context/outer-name + ctx_1)))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_1)))) + (let ((declare-enclosing-module_0 + (promise1.1 + (lambda () + (let ((requires+provides358_0 + requires+provides_0)) + (let ((compiled-module-box365_0 + compiled-module-box_0)) + (let ((requires+provides358_1 + requires+provides358_0)) + (declare-module-for-expansion.1 + submod-ctx_0 + enclosing-self15_0 + compiled-module-box365_0 + id:module-name201_0 + modules-being-compiled_0 + submod-m-ns_0 + rebuild-s_0 + requires+provides358_1 + root-ctx_0 + self_0 + fully-expanded-bodys-except-post-submodules_0))))) + #f))) + (let ((fully-expanded-bodys_0 + (if (stop-at-module*? + submod-ctx_0) + fully-expanded-bodys-except-post-submodules_0 + (let ((requires+provides370_0 + requires+provides_0)) + (let ((compiled-submodules375_0 + compiled-submodules_0)) + (let ((requires+provides370_1 + requires+provides370_0)) + (expand-post-submodules.1 + initial-require-s_0 + compiled-submodules375_0 + submod-ctx_0 + declare-enclosing-module_0 + declared-submodule-names_0 + is-cross-phase-persistent?_0 + modules-being-compiled_0 + mpis-to-reset_0 + 0 + requires+provides370_1 + self_0 + fully-expanded-bodys-except-post-submodules_0))))))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + submod-ctx_0))) + (|parsed-#%module-begin24.1| + rebuild-mb-s_0 + (parsed-only + fully-expanded-bodys_0)) + (let ((mb-result-s_0 + (let ((temp379_0 + (list* + |#%module-begin269_0| + (syntax-only + fully-expanded-bodys_0)))) + (rebuild.1 + #t + rebuild-mb-s_0 + temp379_0)))) + (if (not + (begin-unsafe + (expand-context/inner-in-local-expand? + (root-expand-context/outer-inner + submod-ctx_0)))) + (expanded+parsed1.1 + mb-result-s_0 + (|parsed-#%module-begin24.1| + rebuild-mb-s_0 + (parsed-only + fully-expanded-bodys_0))) + mb-result-s_0)))))))))))))))))))))) + (args + (raise-binding-result-arity-error + 3 + args)))))))))))))) + (let ((mb-ctx_0 + (if (expand-context/outer? + ctx_0) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx_0))) + (let ((inner381_0 + (if (expand-context/inner? + the-struct_0) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + module-begin-k_0 + (expand-context/inner-allow-unbound? + the-struct_0) + #f + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + #f + (expand-context/inner-lift-envs + the-struct_0) + #f + #f + #f + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0)))) + (expand-context/outer1.1 + inner381_0 + (root-expand-context/outer-post-expansion + ctx_0) + (root-expand-context/outer-use-site-scopes + ctx_0) + (root-expand-context/outer-frame-id + ctx_0) + 'module-begin + (expand-context/outer-env + ctx_0) + (expand-context/outer-scopes + ctx_0) + (expand-context/outer-def-ctx-scopes + ctx_0) + (expand-context/outer-binding-layer + ctx_0) + (expand-context/outer-reference-records + ctx_0) + (expand-context/outer-only-immediate? + ctx_0) + (expand-context/outer-need-eventually-defined + ctx_0) + (expand-context/outer-current-introduction-scopes + ctx_0) + (expand-context/outer-current-use-scopes + ctx_0) + (expand-context/outer-name + ctx_0)))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx_0)))) + (let ((mb-scopes-s_0 + (if keep-enclosing-scope-at-phase2_0 + (|#%app| + apply-module-scopes_0 + disarmed-s_0) + initial-require-s_0))) + (let ((mb-def-ctx-scopes_0 + (box + null))) + (let ((mb_0 + (ensure-module-begin.1 + mb-ctx_0 + mb-def-ctx-scopes_0 + m-ns_0 + module-name-sym_0 + 0 + s13_0 + mb-scopes-s_0 + bodys_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next) + (void))) + (let ((expanded-mb_0 + (begin + (if log-performance? + (start-performance-region + 'expand + 'module-begin) + (void)) + (begin0 + (let ((temp397_0 + (let ((v_0 + (accumulate-def-ctx-scopes + mb-ctx_0 + mb-def-ctx-scopes_0))) + (if (expand-context/outer? + v_0) + (let ((inner399_0 + (root-expand-context/outer-inner + v_0))) + (expand-context/outer1.1 + inner399_0 + (root-expand-context/outer-post-expansion + v_0) + (root-expand-context/outer-use-site-scopes + v_0) + (root-expand-context/outer-frame-id + v_0) + (expand-context/outer-context + v_0) + (expand-context/outer-env + v_0) + (expand-context/outer-scopes + v_0) + #f + (expand-context/outer-binding-layer + v_0) + (expand-context/outer-reference-records + v_0) + (expand-context/outer-only-immediate? + v_0) + (expand-context/outer-need-eventually-defined + v_0) + (expand-context/outer-current-introduction-scopes + v_0) + (expand-context/outer-current-use-scopes + v_0) + (expand-context/outer-name + v_0))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + v_0))))) + (expand.1 + #f + #f + mb_0 + temp397_0)) + (if log-performance? + (end-performance-region) + (void)))))) + (call-with-values + (lambda () + (extract-requires-and-provides + requires+provides_0 + self_0 + self_0)) + (case-lambda + ((requires_0 + provides_0) + (let ((result-form_0 + (if (let ((or-part_0 + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + init-ctx14_0))))) + (if or-part_0 + or-part_0 + always-produce-compiled?1_0)) + (let ((app_0 + (requires+provides-all-bindings-simple? + requires+provides_0))) + (let ((app_1 + (root-expand-context-encode-for-module + root-ctx_0 + self_0 + self_0))) + (let ((app_2 + (|parsed-#%module-begin-body| + (if (expanded+parsed? + expanded-mb_0) + (expanded+parsed-parsed + expanded-mb_0) + expanded-mb_0)))) + (let ((app_3 + (unbox + compiled-module-box_0))) + (parsed-module25.1 + rebuild-s_0 + #f + id:module-name201_0 + self_0 + requires_0 + provides_0 + app_0 + app_1 + app_2 + app_3 + compiled-submodules_0))))) + #f))) + (let ((result-s_0 + (if (not + (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + init-ctx14_0)))) + (let ((generic-self_0 + (make-generic-self-module-path-index + self_0))) + (begin + (imitate-generic-module-path-index! + self_0) + (let ((lst_0 + (unbox + mpis-to-reset_0))) + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_1) + (begin + (if (pair? + lst_1) + (let ((mpi_0 + (unsafe-car + lst_1))) + (let ((rest_0 + (unsafe-cdr + lst_1))) + (begin + (imitate-generic-module-path-index! + mpi_0) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + lst_0)))) + (void) + (let ((temp401_0 + (list + module200_0 + id:module-name201_0 + initial-require-s_0 + (expanded+parsed-s + expanded-mb_0)))) + (let ((result-s_0 + (rebuild.1 + #t + rebuild-s_0 + temp401_0))) + (let ((result-s_1 + (syntax-module-path-index-shift.1 + #f + result-s_0 + self_0 + generic-self_0 + #f))) + (let ((result-s_2 + (attach-root-expand-context-properties + result-s_1 + root-ctx_0 + self_0 + generic-self_0))) + (let ((result-s_3 + (if (requires+provides-all-bindings-simple? + requires+provides_0) + (syntax-property$1 + result-s_2 + 'module-body-context-simple? + #t) + result-s_2))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + init-ctx14_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'rename-one + result-s_3) + (void))) + result-s_3)))))))) + (void)))) + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + init-ctx14_0))) + result-form_0 + (if always-produce-compiled?1_0 + (expanded+parsed1.1 + result-s_0 + result-form_0) + result-s_0))))) + (args + (raise-binding-result-arity-error + 2 + args))))))))))))))))))))))))))))))))))))))))) (args (raise-binding-result-arity-error 5 args))))))))))) (define ensure-module-begin.1 (|#%name| @@ -89840,50 +87567,23 @@ (if (expand-context/outer? ctx20_0) (let ((inner408_0 (root-expand-context/outer-inner ctx20_0))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx20_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx20_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx20_0))) - (let ((app_3 (expand-context/outer-env ctx20_0))) - (let ((app_4 - (expand-context/outer-scopes ctx20_0))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx20_0))) - (let ((app_6 - (expand-context/outer-reference-records - ctx20_0))) - (let ((app_7 - (expand-context/outer-need-eventually-defined - ctx20_0))) - (let ((app_8 - (expand-context/outer-current-introduction-scopes - ctx20_0))) - (let ((app_9 - (expand-context/outer-current-use-scopes - ctx20_0))) - (expand-context/outer1.1 - inner408_0 - app_0 - app_1 - app_2 - 'module-begin - app_3 - app_4 - def-ctx-scopes21_0 - app_5 - app_6 - #t - app_7 - app_8 - app_9 - (expand-context/outer-name - ctx20_0))))))))))))) + (expand-context/outer1.1 + inner408_0 + (root-expand-context/outer-post-expansion ctx20_0) + (root-expand-context/outer-use-site-scopes ctx20_0) + (root-expand-context/outer-frame-id ctx20_0) + 'module-begin + (expand-context/outer-env ctx20_0) + (expand-context/outer-scopes ctx20_0) + def-ctx-scopes21_0 + (expand-context/outer-binding-layer ctx20_0) + (expand-context/outer-reference-records ctx20_0) + #t + (expand-context/outer-need-eventually-defined ctx20_0) + (expand-context/outer-current-introduction-scopes + ctx20_0) + (expand-context/outer-current-use-scopes ctx20_0) + (expand-context/outer-name ctx20_0))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -90196,684 +87896,88 @@ (void)))))) (let ((disarmed-exp-body_0 (syntax-disarm$1 exp-body_0))) - (let ((lifted-defns_0 - (let ((lifts_0 - (begin-unsafe - (expand-context/inner-lifts - (root-expand-context/outer-inner - ctx43_0))))) + (let ((lifts_0 + (begin-unsafe + (expand-context/inner-lifts + (root-expand-context/outer-inner + ctx43_0))))) + (let ((lifted-defns_0 (begin-unsafe (box-clear! - (lift-context-lifts lifts_0)))))) - (let ((lifted-reqs_0 - (let ((require-lifts_0 - (begin-unsafe - (expand-context/inner-require-lifts - (root-expand-context/outer-inner - ctx43_0))))) + (lift-context-lifts lifts_0))))) + (let ((require-lifts_0 (begin-unsafe - (box-clear! - (require-lift-context-requires - require-lifts_0)))))) - (let ((lifted-mods_0 - (let ((module-lifts_0 - (begin-unsafe - (expand-context/inner-module-lifts - (root-expand-context/outer-inner - ctx43_0))))) + (expand-context/inner-require-lifts + (root-expand-context/outer-inner + ctx43_0))))) + (let ((lifted-reqs_0 (begin-unsafe (box-clear! - (module-lift-context-lifts - module-lifts_0)))))) - (let ((added-lifted-mods_0 - (add-post-expansion-scope - lifted-mods_0 - ctx43_0))) - (begin - (if (if (null? lifted-defns_0) - (if (null? lifted-reqs_0) - (null? lifted-mods_0) - #f) - #f) - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'module-pass1-lifts - (lifted-defns-extract-syntax - lifted-defns_0) - lifted-reqs_0 - added-lifted-mods_0) - (void)))) - (let ((exp-lifted-mods_0 - (loop_0 #f added-lifted-mods_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'module-pass1-case - exp-body_0) - (void))) - (let ((finish_0 - (|#%name| - finish - (lambda () - (begin - (let ((tmp_0 - (core-form-sym - disarmed-exp-body_0 - phase42_0))) - (if (eq? tmp_0 'begin) + (require-lift-context-requires + require-lifts_0))))) + (let ((module-lifts_0 + (begin-unsafe + (expand-context/inner-module-lifts + (root-expand-context/outer-inner + ctx43_0))))) + (let ((lifted-mods_0 + (begin-unsafe + (box-clear! + (module-lift-context-lifts + module-lifts_0))))) + (let ((added-lifted-mods_0 + (add-post-expansion-scope + lifted-mods_0 + ctx43_0))) + (begin + (if (if (null? lifted-defns_0) + (if (null? lifted-reqs_0) + (null? lifted-mods_0) + #f) + #f) + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'module-pass1-lifts + (lifted-defns-extract-syntax + lifted-defns_0) + lifted-reqs_0 + added-lifted-mods_0) + (void)))) + (let ((exp-lifted-mods_0 + (loop_0 + #f + added-lifted-mods_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'module-pass1-case + exp-body_0) + (void))) + (let ((finish_0 + (|#%name| + finish + (lambda () (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-begin - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-exp-body_0) - (syntax-e$1 - disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? - s_0) - (let ((begin439_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((e440_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - flat-s_0)))))) - (let ((begin439_1 - begin439_0)) - (values - begin439_1 - e440_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((begin437_0 - e438_0) - (values - #t - begin437_0 - e438_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - begin437_0 - e438_0) - (let ((track_0 - (|#%name| - track - (lambda (e_0) - (begin - (syntax-track-origin$1 - e_0 - exp-body_0)))))) - (let ((spliced-bodys_0 - (append - (map_1346 - track_0 - e438_0) - rest-bodys_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'splice - spliced-bodys_0) - (void))) - (loop_0 - tail?_0 - spliced-bodys_0))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (eq? - tmp_0 - 'begin-for-syntax) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-begin-for-syntax - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-exp-body_0) - (syntax-e$1 - disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? - s_0) - (let ((begin-for-syntax443_0 - (let ((s_1 - (car - s_0))) - s_1))) - (let ((e444_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - flat-s_0)))))) - (let ((begin-for-syntax443_1 - begin-for-syntax443_0)) - (values - begin-for-syntax443_1 - e444_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((begin-for-syntax441_0 - e442_0) - (values - #t - begin-for-syntax441_0 - e442_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - begin-for-syntax441_0 - e442_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prepare-env) - (void))) - (let ((ct-m-ns_0 - (namespace->namespace-at-phase - namespace44_0 - (add1 - phase42_0)))) - (begin - (prepare-next-phase-namespace - ctx43_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'phase-up) - (void))) - (let ((nested-bodys_0 - (|#%app| - loop56_0 - e442_0 - (add1 - phase42_0) - #f))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void))) - (namespace-run-available-modules! - namespace44_0 - (add1 - phase42_0)) - (eval-nested-bodys - nested-bodys_0 - (add1 - phase42_0) - ct-m-ns_0 - self45_0 - ctx43_0) - (namespace-visit-available-modules! - namespace44_0 - phase42_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - (let ((s-nested-bodys_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((nested-body_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (extract-syntax - nested-body_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - nested-bodys_0)))))) - (cons - begin-for-syntax441_0 - s-nested-bodys_0))) - (void))) - (cons - (semi-parsed-begin-for-syntax3.1 - exp-body_0 - nested-bodys_0) - (loop_0 - tail?_0 - rest-bodys_0))))))))) - (args - (raise-binding-result-arity-error - 3 - args))))) - (if (eq? - tmp_0 - 'define-values) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-define-values - disarmed-exp-body_0) - (void))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - disarmed-exp-body_0) - (syntax-e$1 - disarmed-exp-body_0) - disarmed-exp-body_0))) - (if (pair? - s_0) - (let ((define-values448_0 - (let ((s_1 - (car - s_0))) - s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id451_0 - (let ((s_3 - (car - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (id_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((s_5 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((id_1 - (let ((id_1 - (let ((id464_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-exp-body_0 - s_5)))) - (cons - id464_0 - id_0)))) - (values - id_1)))) - (for-loop_0 - id_1 - rest_0)))) - id_0)))))) - (for-loop_0 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((rhs452_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((rhs453_0 - (let ((s_5 - (car - s_4))) - s_5))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - (() - (let ((rhs453_1 - rhs453_0)) - (values - rhs453_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))))) - (let ((id451_1 - id451_0)) - (values - id451_1 - rhs452_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - ((id449_0 - rhs450_0) - (let ((define-values448_1 - define-values448_0)) - (values - define-values448_1 - id449_0 - rhs450_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))) - (case-lambda - ((define-values445_0 - id446_0 - rhs447_0) - (values - #t - define-values445_0 - id446_0 - rhs447_0)) - (args - (raise-binding-result-arity-error - 3 - args))))) - (case-lambda - ((ok?_0 - define-values445_0 - id446_0 - rhs447_0) - (let ((ids_0 - (remove-use-site-scopes - id446_0 - ctx43_0))) - (begin - (check-no-duplicate-ids.1 - unsafe-undefined - ids_0 - phase42_0 - exp-body_0 - unsafe-undefined) - (begin - (check-ids-unbound.1 - exp-body_0 - ids_0 - phase42_0 - requires-and-provides47_0) - (let ((syms_0 - (select-defined-syms-and-bind!.1 - #f - frame-id46_0 - exp-body_0 - requires-and-provides47_0 - #f - ids_0 - defined-syms50_0 - self45_0 - phase42_0 - all-scopes-stx49_0))) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? - lst_0) - (let ((sym_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (begin - (namespace-unset-transformer! - namespace44_0 - phase42_0 - sym_0) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - syms_0))) - (void) - (add-defined-syms!.1 - #f - requires-and-provides47_0 - syms_0 - phase42_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - (list - define-values445_0 - ids_0 - rhs447_0)) - (void))) - (cons - (semi-parsed-define-values2.1 - exp-body_0 - syms_0 - ids_0 - rhs447_0) - (loop_0 - tail?_0 - rest-bodys_0)))))))) - (args - (raise-binding-result-arity-error - 4 - args))))) + (let ((tmp_0 + (core-form-sym + disarmed-exp-body_0 + phase42_0))) (if (eq? tmp_0 - 'define-syntaxes) + 'begin) (begin (let ((obs_0 (begin-unsafe @@ -90883,7 +87987,7 @@ (if obs_0 (call-expand-observe obs_0 - 'prim-define-syntaxes + 'prim-begin disarmed-exp-body_0) (void))) (call-with-values @@ -90898,201 +88002,69 @@ disarmed-exp-body_0))) (if (pair? s_0) - (let ((define-syntaxes476_0 + (let ((begin439_0 (let ((s_1 (car s_0))) s_1))) - (call-with-values - (lambda () - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 - s_1) - s_1))) - (if (pair? - s_2) - (let ((id479_0 - (let ((s_3 - (car - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (let ((flat-s_0 - (to-syntax-list.1 - s_4))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0) - (let ((id_0 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (id_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((s_5 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((id_1 - (let ((id_1 - (let ((id493_0 - (if (let ((or-part_0 - (if (syntax?$1 - s_5) - (symbol? - (syntax-e$1 - s_5)) - #f))) - (if or-part_0 - or-part_0 - (symbol? - s_5))) - s_5 - (raise-syntax-error$1 - #f - "not an identifier" - disarmed-exp-body_0 - s_5)))) - (cons - id493_0 - id_0)))) - (values - id_1)))) - (for-loop_0 - id_1 - rest_0)))) - id_0)))))) - (for-loop_0 - null - flat-s_0))))) - (reverse$1 - id_0)))))))) - (let ((rhs480_0 - (let ((s_3 - (cdr - s_2))) - (let ((s_4 - (if (syntax?$1 - s_3) - (syntax-e$1 - s_3) - s_3))) - (if (pair? - s_4) - (let ((rhs481_0 - (let ((s_5 - (car - s_4))) - s_5))) - (call-with-values - (lambda () - (let ((s_5 - (cdr - s_4))) - (let ((s_6 - (if (syntax?$1 - s_5) - (syntax-e$1 - s_5) - s_5))) - (if (null? - s_6) - (values) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - (() - (let ((rhs481_1 - rhs481_0)) - (values - rhs481_1))) - (args - (raise-binding-result-arity-error - 0 - args))))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0)))))) - (let ((id479_1 - id479_0)) - (values - id479_1 - rhs480_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - disarmed-exp-body_0))))) - (case-lambda - ((id477_0 - rhs478_0) - (let ((define-syntaxes476_1 - define-syntaxes476_0)) - (values - define-syntaxes476_1 - id477_0 - rhs478_0))) - (args - (raise-binding-result-arity-error - 2 - args))))) + (let ((e440_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + flat-s_0)))))) + (let ((begin439_1 + begin439_0)) + (values + begin439_1 + e440_0)))) (raise-syntax-error$1 #f "bad syntax" disarmed-exp-body_0)))) (case-lambda - ((define-syntaxes473_0 - id474_0 - rhs475_0) + ((begin437_0 + e438_0) (values #t - define-syntaxes473_0 - id474_0 - rhs475_0)) + begin437_0 + e438_0)) (args (raise-binding-result-arity-error - 3 + 2 args))))) (case-lambda ((ok?_0 - define-syntaxes473_0 - id474_0 - rhs475_0) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prepare-env) - (void))) - (begin - (prepare-next-phase-namespace - ctx43_0) + begin437_0 + e438_0) + (let ((track_0 + (|#%name| + track + (lambda (e_0) + (begin + (syntax-track-origin$1 + e_0 + exp-body_0)))))) + (let ((spliced-bodys_0 + (append + (map_1346 + track_0 + e438_0) + rest-bodys_0))) (begin (let ((obs_0 (begin-unsafe @@ -91102,343 +88074,19 @@ (if obs_0 (call-expand-observe obs_0 - 'phase-up) + 'splice + spliced-bodys_0) (void))) - (let ((ids_0 - (remove-use-site-scopes - id474_0 - ctx43_0))) - (begin - (check-no-duplicate-ids.1 - unsafe-undefined - ids_0 - phase42_0 - exp-body_0 - unsafe-undefined) - (begin - (check-ids-unbound.1 - exp-body_0 - ids_0 - phase42_0 - requires-and-provides47_0) - (let ((syms_0 - (select-defined-syms-and-bind!.1 - #t - frame-id46_0 - exp-body_0 - requires-and-provides47_0 - #f - ids_0 - defined-syms50_0 - self45_0 - phase42_0 - all-scopes-stx49_0))) - (begin - (add-defined-syms!.1 - #t - requires-and-provides47_0 - syms_0 - phase42_0) - (call-with-values - (lambda () - (let ((temp506_0 - (if (expand-context/outer? - ctx43_0) - (let ((inner509_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx43_0))) - (if (expand-context/inner? - the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-stops - the-struct_0))) - (let ((app_16 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_22 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_23 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_24 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - app_16 - #f - app_17 - #f - app_18 - #f - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - ctx43_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - ctx43_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - ctx43_0))) - (let ((app_3 - (expand-context/outer-context - ctx43_0))) - (let ((app_4 - (expand-context/outer-env - ctx43_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx43_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx43_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx43_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx43_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx43_0))) - (let ((app_10 - (expand-context/outer-current-introduction-scopes - ctx43_0))) - (let ((app_11 - (expand-context/outer-current-use-scopes - ctx43_0))) - (expand-context/outer1.1 - inner509_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - need-eventually-defined48_0 - app_10 - app_11 - (expand-context/outer-name - ctx43_0))))))))))))))) - (raise-argument-error - 'struct-copy - "expand-context/outer?" - ctx43_0)))) - (expand+eval-for-syntaxes-binding.1 - #f - 'define-syntaxes - rhs475_0 - ids_0 - temp506_0))) - (case-lambda - ((exp-rhs_0 - parsed-rhs_0 - vals_0) - (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0 - lst_1 - lst_2) - (begin - (if (if (pair? - lst_0) - (if (pair? - lst_1) - (pair? - lst_2) - #f) - #f) - (let ((sym_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((val_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr - lst_1))) - (let ((id_0 - (unsafe-car - lst_2))) - (let ((rest_2 - (unsafe-cdr - lst_2))) - (begin - (begin - (maybe-install-free=id-in-context! - val_0 - id_0 - phase42_0 - ctx43_0) - (namespace-set-transformer! - namespace44_0 - phase42_0 - sym_0 - val_0)) - (for-loop_0 - rest_0 - rest_1 - rest_2)))))))) - (values))))))) - (for-loop_0 - syms_0 - vals_0 - ids_0))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - (list - define-syntaxes473_0 - ids_0 - exp-rhs_0)) - (void))) - (let ((parsed-body_0 - (parsed-define-syntaxes20.1 - (keep-properties-only - exp-body_0) - ids_0 - syms_0 - parsed-rhs_0))) - (let ((app_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx43_0))) - parsed-body_0 - (expanded+parsed1.1 - (let ((temp514_0 - (list - define-syntaxes473_0 - ids_0 - exp-rhs_0))) - (rebuild.1 - #t - exp-body_0 - temp514_0)) - parsed-body_0)))) - (cons - app_0 - (loop_0 - tail?_0 - rest-bodys_0))))))) - (args - (raise-binding-result-arity-error - 3 - args))))))))))))) + (loop_0 + tail?_0 + spliced-bodys_0))))) (args (raise-binding-result-arity-error - 4 + 3 args))))) (if (eq? tmp_0 - '|#%require|) + 'begin-for-syntax) (begin (let ((obs_0 (begin-unsafe @@ -91448,114 +88096,194 @@ (if obs_0 (call-expand-observe obs_0 - 'prim-require + 'prim-begin-for-syntax disarmed-exp-body_0) (void))) - (let ((ready-body_0 - (remove-use-site-scopes - disarmed-exp-body_0 - ctx43_0))) - (call-with-values - (lambda () - (call-with-values - (lambda () - (let ((s_0 - (if (syntax?$1 - ready-body_0) - (syntax-e$1 - ready-body_0) - ready-body_0))) - (if (pair? - s_0) - (let ((|#%require517_0| + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((begin-for-syntax443_0 + (let ((s_1 + (car + s_0))) + s_1))) + (let ((e444_0 (let ((s_1 - (car + (cdr s_0))) - s_1))) - (let ((req518_0 - (let ((s_1 - (cdr - s_0))) - (let ((s_2 - (if (syntax?$1 - s_1) - (syntax-e$1 + (let ((s_2 + (if (syntax?$1 s_1) - s_1))) - (let ((flat-s_0 - (to-syntax-list.1 - s_2))) - (if (not - flat-s_0) - (raise-syntax-error$1 - #f - "bad syntax" - ready-body_0) - flat-s_0)))))) - (let ((|#%require517_1| - |#%require517_0|)) - (values - |#%require517_1| - req518_0)))) - (raise-syntax-error$1 - #f - "bad syntax" - ready-body_0)))) - (case-lambda - ((|#%require515_0| - req516_0) - (values - #t - |#%require515_0| - req516_0)) - (args - (raise-binding-result-arity-error - 2 - args))))) - (case-lambda - ((ok?_0 - |#%require515_0| - req516_0) - (begin - (parse-and-perform-requires!.1 - #f - #f - declared-submodule-names52_0 - #f - phase42_0 - #f - self45_0 - #f - #t - 'module - req516_0 - exp-body_0 - namespace44_0 - phase42_0 - requires-and-provides47_0) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-case - ready-body_0) - (void))) - (cons - exp-body_0 - (loop_0 - tail?_0 - rest-bodys_0)))) - (args - (raise-binding-result-arity-error - 3 - args)))))) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + flat-s_0)))))) + (let ((begin-for-syntax443_1 + begin-for-syntax443_0)) + (values + begin-for-syntax443_1 + e444_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((begin-for-syntax441_0 + e442_0) + (values + #t + begin-for-syntax441_0 + e442_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + begin-for-syntax441_0 + e442_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (let ((ct-m-ns_0 + (namespace->namespace-at-phase + namespace44_0 + (add1 + phase42_0)))) + (begin + (prepare-next-phase-namespace + ctx43_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'phase-up) + (void))) + (let ((nested-bodys_0 + (|#%app| + loop56_0 + e442_0 + (add1 + phase42_0) + #f))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void))) + (namespace-run-available-modules! + namespace44_0 + (add1 + phase42_0)) + (eval-nested-bodys + nested-bodys_0 + (add1 + phase42_0) + ct-m-ns_0 + self45_0 + ctx43_0) + (namespace-visit-available-modules! + namespace44_0 + phase42_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + (let ((s-nested-bodys_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((nested-body_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (extract-syntax + nested-body_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + nested-bodys_0)))))) + (cons + begin-for-syntax441_0 + s-nested-bodys_0))) + (void))) + (let ((app_0 + (semi-parsed-begin-for-syntax3.1 + exp-body_0 + nested-bodys_0))) + (cons + app_0 + (loop_0 + tail?_0 + rest-bodys_0)))))))))) + (args + (raise-binding-result-arity-error + 3 + args))))) (if (eq? tmp_0 - '|#%provide|) + 'define-values) (begin (let ((obs_0 (begin-unsafe @@ -91565,17 +88293,295 @@ (if obs_0 (call-expand-observe obs_0 - 'prim-stop - #f) + 'prim-define-values + disarmed-exp-body_0) (void))) - (cons - exp-body_0 - (loop_0 - tail?_0 - rest-bodys_0))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((define-values448_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id451_0 + (let ((s_3 + (car + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (id_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((s_5 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((id_1 + (let ((id_1 + (let ((id464_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-exp-body_0 + s_5)))) + (cons + id464_0 + id_0)))) + (values + id_1)))) + (for-loop_0 + id_1 + rest_0)))) + id_0)))))) + (for-loop_0 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((rhs452_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((rhs453_0 + (let ((s_5 + (car + s_4))) + s_5))) + (call-with-values + (lambda () + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (null? + s_6) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + (() + (let ((rhs453_1 + rhs453_0)) + (values + rhs453_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))))) + (let ((id451_1 + id451_0)) + (values + id451_1 + rhs452_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + ((id449_0 + rhs450_0) + (let ((define-values448_1 + define-values448_0)) + (values + define-values448_1 + id449_0 + rhs450_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((define-values445_0 + id446_0 + rhs447_0) + (values + #t + define-values445_0 + id446_0 + rhs447_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + define-values445_0 + id446_0 + rhs447_0) + (let ((ids_0 + (remove-use-site-scopes + id446_0 + ctx43_0))) + (begin + (check-no-duplicate-ids.1 + unsafe-undefined + ids_0 + phase42_0 + exp-body_0 + unsafe-undefined) + (begin + (check-ids-unbound.1 + exp-body_0 + ids_0 + phase42_0 + requires-and-provides47_0) + (let ((syms_0 + (select-defined-syms-and-bind!.1 + #f + frame-id46_0 + exp-body_0 + requires-and-provides47_0 + #f + ids_0 + defined-syms50_0 + self45_0 + phase42_0 + all-scopes-stx49_0))) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((sym_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (namespace-unset-transformer! + namespace44_0 + phase42_0 + sym_0) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + syms_0))) + (void) + (add-defined-syms!.1 + #f + requires-and-provides47_0 + syms_0 + phase42_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + (list + define-values445_0 + ids_0 + rhs447_0)) + (void))) + (let ((app_0 + (semi-parsed-define-values2.1 + exp-body_0 + syms_0 + ids_0 + rhs447_0))) + (cons + app_0 + (loop_0 + tail?_0 + rest-bodys_0))))))))) + (args + (raise-binding-result-arity-error + 4 + args))))) (if (eq? tmp_0 - 'module) + 'define-syntaxes) (begin (let ((obs_0 (begin-unsafe @@ -91585,34 +88591,488 @@ (if obs_0 (call-expand-observe obs_0 - 'prim-submodule - #f) + 'prim-define-syntaxes + disarmed-exp-body_0) (void))) - (let ((ready-body_0 - (remove-use-site-scopes - exp-body_0 - ctx43_0))) - (let ((submod_0 - (expand-submodule.1 - compiled-submodules53_0 - declared-submodule-names52_0 - #f - #f - #f - #f - modules-being-compiled54_0 - mpis-to-reset55_0 - ready-body_0 - self45_0 - ctx43_0))) - (cons - submod_0 - (loop_0 - tail?_0 - rest-bodys_0))))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((define-syntaxes476_0 + (let ((s_1 + (car + s_0))) + s_1))) + (call-with-values + (lambda () + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (if (pair? + s_2) + (let ((id479_0 + (let ((s_3 + (car + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (let ((flat-s_0 + (to-syntax-list.1 + s_4))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + (let ((id_0 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (id_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((s_5 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((id_1 + (let ((id_1 + (let ((id493_0 + (if (let ((or-part_0 + (if (syntax?$1 + s_5) + (symbol? + (syntax-e$1 + s_5)) + #f))) + (if or-part_0 + or-part_0 + (symbol? + s_5))) + s_5 + (raise-syntax-error$1 + #f + "not an identifier" + disarmed-exp-body_0 + s_5)))) + (cons + id493_0 + id_0)))) + (values + id_1)))) + (for-loop_0 + id_1 + rest_0)))) + id_0)))))) + (for-loop_0 + null + flat-s_0))))) + (reverse$1 + id_0)))))))) + (let ((rhs480_0 + (let ((s_3 + (cdr + s_2))) + (let ((s_4 + (if (syntax?$1 + s_3) + (syntax-e$1 + s_3) + s_3))) + (if (pair? + s_4) + (let ((rhs481_0 + (let ((s_5 + (car + s_4))) + s_5))) + (call-with-values + (lambda () + (let ((s_5 + (cdr + s_4))) + (let ((s_6 + (if (syntax?$1 + s_5) + (syntax-e$1 + s_5) + s_5))) + (if (null? + s_6) + (values) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + (() + (let ((rhs481_1 + rhs481_0)) + (values + rhs481_1))) + (args + (raise-binding-result-arity-error + 0 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))))) + (let ((id479_1 + id479_0)) + (values + id479_1 + rhs480_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0))))) + (case-lambda + ((id477_0 + rhs478_0) + (let ((define-syntaxes476_1 + define-syntaxes476_0)) + (values + define-syntaxes476_1 + id477_0 + rhs478_0))) + (args + (raise-binding-result-arity-error + 2 + args))))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((define-syntaxes473_0 + id474_0 + rhs475_0) + (values + #t + define-syntaxes473_0 + id474_0 + rhs475_0)) + (args + (raise-binding-result-arity-error + 3 + args))))) + (case-lambda + ((ok?_0 + define-syntaxes473_0 + id474_0 + rhs475_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prepare-env) + (void))) + (begin + (prepare-next-phase-namespace + ctx43_0) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'phase-up) + (void))) + (let ((ids_0 + (remove-use-site-scopes + id474_0 + ctx43_0))) + (begin + (check-no-duplicate-ids.1 + unsafe-undefined + ids_0 + phase42_0 + exp-body_0 + unsafe-undefined) + (begin + (check-ids-unbound.1 + exp-body_0 + ids_0 + phase42_0 + requires-and-provides47_0) + (let ((syms_0 + (select-defined-syms-and-bind!.1 + #t + frame-id46_0 + exp-body_0 + requires-and-provides47_0 + #f + ids_0 + defined-syms50_0 + self45_0 + phase42_0 + all-scopes-stx49_0))) + (begin + (add-defined-syms!.1 + #t + requires-and-provides47_0 + syms_0 + phase42_0) + (call-with-values + (lambda () + (let ((temp506_0 + (if (expand-context/outer? + ctx43_0) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx43_0))) + (let ((inner509_0 + (if (expand-context/inner? + the-struct_0) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + #f + (expand-context/inner-lift-envs + the-struct_0) + #f + (expand-context/inner-require-lifts + the-struct_0) + #f + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) + (raise-argument-error + 'struct-copy + "expand-context/inner?" + the-struct_0)))) + (expand-context/outer1.1 + inner509_0 + (root-expand-context/outer-post-expansion + ctx43_0) + (root-expand-context/outer-use-site-scopes + ctx43_0) + (root-expand-context/outer-frame-id + ctx43_0) + (expand-context/outer-context + ctx43_0) + (expand-context/outer-env + ctx43_0) + (expand-context/outer-scopes + ctx43_0) + (expand-context/outer-def-ctx-scopes + ctx43_0) + (expand-context/outer-binding-layer + ctx43_0) + (expand-context/outer-reference-records + ctx43_0) + (expand-context/outer-only-immediate? + ctx43_0) + need-eventually-defined48_0 + (expand-context/outer-current-introduction-scopes + ctx43_0) + (expand-context/outer-current-use-scopes + ctx43_0) + (expand-context/outer-name + ctx43_0)))) + (raise-argument-error + 'struct-copy + "expand-context/outer?" + ctx43_0)))) + (expand+eval-for-syntaxes-binding.1 + #f + 'define-syntaxes + rhs475_0 + ids_0 + temp506_0))) + (case-lambda + ((exp-rhs_0 + parsed-rhs_0 + vals_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0 + lst_1 + lst_2) + (begin + (if (if (pair? + lst_0) + (if (pair? + lst_1) + (pair? + lst_2) + #f) + #f) + (let ((sym_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((val_0 + (unsafe-car + lst_1))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((id_0 + (unsafe-car + lst_2))) + (let ((rest_2 + (unsafe-cdr + lst_2))) + (begin + (begin + (maybe-install-free=id-in-context! + val_0 + id_0 + phase42_0 + ctx43_0) + (namespace-set-transformer! + namespace44_0 + phase42_0 + sym_0 + val_0)) + (for-loop_0 + rest_0 + rest_1 + rest_2)))))))) + (values))))))) + (for-loop_0 + syms_0 + vals_0 + ids_0))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + (list + define-syntaxes473_0 + ids_0 + exp-rhs_0)) + (void))) + (let ((parsed-body_0 + (parsed-define-syntaxes20.1 + (keep-properties-only + exp-body_0) + ids_0 + syms_0 + parsed-rhs_0))) + (let ((app_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx43_0))) + parsed-body_0 + (expanded+parsed1.1 + (let ((temp514_0 + (list + define-syntaxes473_0 + ids_0 + exp-rhs_0))) + (rebuild.1 + #t + exp-body_0 + temp514_0)) + parsed-body_0)))) + (cons + app_0 + (loop_0 + tail?_0 + rest-bodys_0))))))) + (args + (raise-binding-result-arity-error + 3 + args))))))))))))) + (args + (raise-binding-result-arity-error + 4 + args))))) (if (eq? tmp_0 - 'module*) + '|#%require|) (begin (let ((obs_0 (begin-unsafe @@ -91622,47 +89082,31 @@ (if obs_0 (call-expand-observe obs_0 - 'prim-stop - #f) + 'prim-require + disarmed-exp-body_0) (void))) - (cons - exp-body_0 - (loop_0 - tail?_0 - rest-bodys_0))) - (if (eq? - tmp_0 - '|#%declare|) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx43_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'prim-declare - disarmed-exp-body_0) - (void))) + (let ((ready-body_0 + (remove-use-site-scopes + disarmed-exp-body_0 + ctx43_0))) (call-with-values (lambda () (call-with-values (lambda () (let ((s_0 (if (syntax?$1 - disarmed-exp-body_0) + ready-body_0) (syntax-e$1 - disarmed-exp-body_0) - disarmed-exp-body_0))) + ready-body_0) + ready-body_0))) (if (pair? s_0) - (let ((|#%declare538_0| + (let ((|#%require517_0| (let ((s_1 (car s_0))) s_1))) - (let ((kw539_0 + (let ((req518_0 (let ((s_1 (cdr s_0))) @@ -91680,125 +89124,72 @@ (raise-syntax-error$1 #f "bad syntax" - disarmed-exp-body_0) + ready-body_0) flat-s_0)))))) - (let ((|#%declare538_1| - |#%declare538_0|)) + (let ((|#%require517_1| + |#%require517_0|)) (values - |#%declare538_1| - kw539_0)))) + |#%require517_1| + req518_0)))) (raise-syntax-error$1 #f "bad syntax" - disarmed-exp-body_0)))) + ready-body_0)))) (case-lambda - ((|#%declare536_0| - kw537_0) + ((|#%require515_0| + req516_0) (values #t - |#%declare536_0| - kw537_0)) + |#%require515_0| + req516_0)) (args (raise-binding-result-arity-error 2 args))))) (case-lambda ((ok?_0 - |#%declare536_0| - kw537_0) + |#%require515_0| + req516_0) (begin - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (lst_0) - (begin - (if (pair? - lst_0) - (let ((kw_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (begin - (begin - (if (keyword? - (syntax-e$1 - kw_0)) - (void) - (raise-syntax-error$1 - #f - "expected a keyword" - exp-body_0 - kw_0)) - (if (memq - (syntax-e$1 - kw_0) - kws2278) - (void) - (raise-syntax-error$1 - #f - "not an allowed declaration keyword" - exp-body_0 - kw_0)) - (if (hash-ref - declared-keywords51_0 - (syntax-e$1 - kw_0) - #f) - (raise-syntax-error$1 - #f - "keyword declared multiple times" - exp-body_0 - kw_0) - (void)) - (if (eq? - (syntax-e$1 - kw_0) - kw2838) - (if (eq? - (current-code-inspector) - initial-code-inspector) - (void) - (raise-syntax-error$1 - #f - "unsafe compilation disallowed by code inspector" - exp-body_0 - kw_0)) - (void)) - (hash-set! - declared-keywords51_0 - (syntax-e$1 - kw_0) - kw_0)) - (for-loop_0 - rest_0)))) - (values))))))) - (for-loop_0 - kw537_0))) - (let ((parsed-body_0 - (|parsed-#%declare22.1| - exp-body_0))) - (let ((app_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx43_0))) - parsed-body_0 - (expanded+parsed1.1 - exp-body_0 - parsed-body_0)))) - (cons - app_0 - (loop_0 - tail?_0 - rest-bodys_0)))))) + (parse-and-perform-requires!.1 + #f + #f + declared-submodule-names52_0 + #f + phase42_0 + #f + self45_0 + #f + #t + 'module + req516_0 + exp-body_0 + namespace44_0 + phase42_0 + requires-and-provides47_0) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-case + ready-body_0) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0)))) (args (raise-binding-result-arity-error 3 - args))))) + args)))))) + (if (eq? + tmp_0 + '|#%provide|) (begin (let ((obs_0 (begin-unsafe @@ -91815,17 +89206,260 @@ exp-body_0 (loop_0 tail?_0 - rest-bodys_0)))))))))))))))))) - (let ((l_0 - (append - lifted-reqs_0 - lifted-defns_0 - exp-lifted-mods_0))) - (if (null? l_0) - (finish_0) - (append - l_0 - (finish_0)))))))))))))))))))))) + rest-bodys_0))) + (if (eq? + tmp_0 + 'module) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-submodule + #f) + (void))) + (let ((ready-body_0 + (remove-use-site-scopes + exp-body_0 + ctx43_0))) + (let ((submod_0 + (expand-submodule.1 + compiled-submodules53_0 + declared-submodule-names52_0 + #f + #f + #f + #f + modules-being-compiled54_0 + mpis-to-reset55_0 + ready-body_0 + self45_0 + ctx43_0))) + (cons + submod_0 + (loop_0 + tail?_0 + rest-bodys_0))))) + (if (eq? + tmp_0 + 'module*) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-stop + #f) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0))) + (if (eq? + tmp_0 + '|#%declare|) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-declare + disarmed-exp-body_0) + (void))) + (call-with-values + (lambda () + (call-with-values + (lambda () + (let ((s_0 + (if (syntax?$1 + disarmed-exp-body_0) + (syntax-e$1 + disarmed-exp-body_0) + disarmed-exp-body_0))) + (if (pair? + s_0) + (let ((|#%declare538_0| + (let ((s_1 + (car + s_0))) + s_1))) + (let ((kw539_0 + (let ((s_1 + (cdr + s_0))) + (let ((s_2 + (if (syntax?$1 + s_1) + (syntax-e$1 + s_1) + s_1))) + (let ((flat-s_0 + (to-syntax-list.1 + s_2))) + (if (not + flat-s_0) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0) + flat-s_0)))))) + (let ((|#%declare538_1| + |#%declare538_0|)) + (values + |#%declare538_1| + kw539_0)))) + (raise-syntax-error$1 + #f + "bad syntax" + disarmed-exp-body_0)))) + (case-lambda + ((|#%declare536_0| + kw537_0) + (values + #t + |#%declare536_0| + kw537_0)) + (args + (raise-binding-result-arity-error + 2 + args))))) + (case-lambda + ((ok?_0 + |#%declare536_0| + kw537_0) + (begin + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (lst_0) + (begin + (if (pair? + lst_0) + (let ((kw_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (begin + (begin + (if (keyword? + (syntax-e$1 + kw_0)) + (void) + (raise-syntax-error$1 + #f + "expected a keyword" + exp-body_0 + kw_0)) + (if (memq + (syntax-e$1 + kw_0) + kws2278) + (void) + (raise-syntax-error$1 + #f + "not an allowed declaration keyword" + exp-body_0 + kw_0)) + (if (hash-ref + declared-keywords51_0 + (syntax-e$1 + kw_0) + #f) + (raise-syntax-error$1 + #f + "keyword declared multiple times" + exp-body_0 + kw_0) + (void)) + (if (eq? + (syntax-e$1 + kw_0) + kw2838) + (if (eq? + (current-code-inspector) + initial-code-inspector) + (void) + (raise-syntax-error$1 + #f + "unsafe compilation disallowed by code inspector" + exp-body_0 + kw_0)) + (void)) + (hash-set! + declared-keywords51_0 + (syntax-e$1 + kw_0) + kw_0)) + (for-loop_0 + rest_0)))) + (values))))))) + (for-loop_0 + kw537_0))) + (let ((parsed-body_0 + (|parsed-#%declare22.1| + exp-body_0))) + (let ((app_0 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx43_0))) + parsed-body_0 + (expanded+parsed1.1 + exp-body_0 + parsed-body_0)))) + (cons + app_0 + (loop_0 + tail?_0 + rest-bodys_0)))))) + (args + (raise-binding-result-arity-error + 3 + args))))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx43_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'prim-stop + #f) + (void))) + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0)))))))))))))))))) + (let ((l_0 + (append + lifted-reqs_0 + lifted-defns_0 + exp-lifted-mods_0))) + (if (null? l_0) + (finish_0) + (append + l_0 + (finish_0))))))))))))))))))))))))) (loop_0 #t bodys72_0))))))) (define make-wrap-as-definition (lambda (self_0 @@ -92277,109 +89911,109 @@ (if log-performance? (end-performance-region) (void))))))))))) - (let ((lifted-defns_0 - (let ((lifts_0 - (begin-unsafe - (expand-context/inner-lifts - (root-expand-context/outer-inner - ctx75_0))))) + (let ((lifts_0 + (begin-unsafe + (expand-context/inner-lifts + (root-expand-context/outer-inner ctx75_0))))) + (let ((lifted-defns_0 (begin-unsafe - (box-clear! - (lift-context-lifts lifts_0)))))) - (let ((lifted-requires_0 - (let ((require-lifts_0 - (begin-unsafe - (expand-context/inner-require-lifts - (root-expand-context/outer-inner - ctx75_0))))) + (box-clear! (lift-context-lifts lifts_0))))) + (let ((require-lifts_0 (begin-unsafe - (box-clear! - (require-lift-context-requires - require-lifts_0)))))) - (let ((lifted-modules_0 - (let ((module-lifts_0 - (begin-unsafe - (expand-context/inner-module-lifts - (root-expand-context/outer-inner - ctx75_0))))) + (expand-context/inner-require-lifts + (root-expand-context/outer-inner + ctx75_0))))) + (let ((lifted-requires_0 (begin-unsafe (box-clear! - (module-lift-context-lifts - module-lifts_0)))))) - (let ((no-lifts?_0 - (if (null? lifted-defns_0) - (if (null? lifted-modules_0) - (null? lifted-requires_0) - #f) - #f))) - (begin - (if no-lifts?_0 - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (let ((app_0 - (add-post-expansion-scope - lifted-modules_0 - ctx75_0))) - (call-expand-observe - obs_0 - 'module-pass2-lifts - lifted-requires_0 - app_0 - (lifted-defns-extract-syntax - lifted-defns_0))) - (void)))) - (let ((exp-lifted-modules_0 - (expand-non-module*-submodules.1 - compiled-submodules78_0 - declared-submodule-names77_0 - modules-being-compiled79_0 - mpis-to-reset80_0 - lifted-modules_0 - phase74_0 - self76_0 - ctx75_0))) - (begin - (if no-lifts?_0 - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'next-group) - (void)))) - (let ((exp-lifted-defns_0 - (loop_0 #f lifted-defns_0))) - (begin - (if no-lifts?_0 - (void) - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx75_0))))) - (if obs_0 + (require-lift-context-requires + require-lifts_0))))) + (let ((module-lifts_0 + (begin-unsafe + (expand-context/inner-module-lifts + (root-expand-context/outer-inner + ctx75_0))))) + (let ((lifted-modules_0 + (begin-unsafe + (box-clear! + (module-lift-context-lifts + module-lifts_0))))) + (let ((no-lifts?_0 + (if (null? lifted-defns_0) + (if (null? lifted-modules_0) + (null? lifted-requires_0) + #f) + #f))) + (begin + (if no-lifts?_0 + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (let ((app_0 + (add-post-expansion-scope + lifted-modules_0 + ctx75_0))) (call-expand-observe obs_0 - 'next-group) - (void)))) - (append - lifted-requires_0 - exp-lifted-modules_0 - exp-lifted-defns_0 - (cons - exp-body_0 - (loop_0 - tail?_0 - rest-bodys_0)))))))))))))))))))))) + 'module-pass2-lifts + lifted-requires_0 + app_0 + (lifted-defns-extract-syntax + lifted-defns_0))) + (void)))) + (let ((exp-lifted-modules_0 + (expand-non-module*-submodules.1 + compiled-submodules78_0 + declared-submodule-names77_0 + modules-being-compiled79_0 + mpis-to-reset80_0 + lifted-modules_0 + phase74_0 + self76_0 + ctx75_0))) + (begin + (if no-lifts?_0 + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void)))) + (let ((exp-lifted-defns_0 + (loop_0 + #f + lifted-defns_0))) + (begin + (if no-lifts?_0 + (void) + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx75_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'next-group) + (void)))) + (append + lifted-requires_0 + exp-lifted-modules_0 + exp-lifted-defns_0 + (cons + exp-body_0 + (loop_0 + tail?_0 + rest-bodys_0))))))))))))))))))))))))) (loop_0 #t partially-expanded-bodys88_0)))))) (define check-defined-by-now (lambda (need-eventually-defined_0 self_0 ctx_0 requires+provides_0) @@ -92644,176 +90278,104 @@ self94_0 phase_0 (if (expand-context/outer? ctx95_0) - (let ((inner585_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx95_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx95_0))) + (let ((inner585_0 (if (expand-context/inner? the-struct_0) (let ((namespace587_0 (namespace->namespace-at-phase namespace92_0 phase_0))) - (let ((app_1 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_7 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_8 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_16 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_17 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-observer - the-struct_0))) - (let ((app_21 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_22 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_23 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_24 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - phase_0 - namespace587_0 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - declared-submodule-names91_0 - app_15 - app_16 - app_17 - app_18 - app_19 - requires-and-provides90_0 - app_20 - app_21 - app_22 - app_23 - app_24 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + phase_0 + namespace587_0 + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + declared-submodule-names91_0 + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + requires-and-provides90_0 + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_1 - (root-expand-context/outer-post-expansion - ctx95_0))) - (let ((app_2 - (root-expand-context/outer-use-site-scopes - ctx95_0))) - (let ((app_3 - (root-expand-context/outer-frame-id - ctx95_0))) - (let ((app_4 - (expand-context/outer-env - ctx95_0))) - (let ((app_5 - (expand-context/outer-scopes - ctx95_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - ctx95_0))) - (let ((app_7 - (expand-context/outer-binding-layer - ctx95_0))) - (let ((app_8 - (expand-context/outer-reference-records - ctx95_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - ctx95_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - ctx95_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - ctx95_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - ctx95_0))) - (expand-context/outer1.1 - inner585_0 - app_1 - app_2 - app_3 - 'top-level - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - ctx95_0))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner585_0 + (root-expand-context/outer-post-expansion + ctx95_0) + (root-expand-context/outer-use-site-scopes + ctx95_0) + (root-expand-context/outer-frame-id + ctx95_0) + 'top-level + (expand-context/outer-env + ctx95_0) + (expand-context/outer-scopes + ctx95_0) + (expand-context/outer-def-ctx-scopes + ctx95_0) + (expand-context/outer-binding-layer + ctx95_0) + (expand-context/outer-reference-records + ctx95_0) + (expand-context/outer-only-immediate? + ctx95_0) + (expand-context/outer-need-eventually-defined + ctx95_0) + (expand-context/outer-current-introduction-scopes + ctx95_0) + (expand-context/outer-current-use-scopes + ctx95_0) + (expand-context/outer-name + ctx95_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -92905,10 +90467,10 @@ self108_0)) (case-lambda ((requires_0 provides_0) - (let ((parsed-mod_0 - (let ((app_0 - (requires+provides-all-bindings-simple? - requires-and-provides106_0))) + (let ((app_0 + (requires+provides-all-bindings-simple? + requires-and-provides106_0))) + (let ((parsed-mod_0 (let ((app_1 (root-expand-context-encode-for-module root-ctx110_0 @@ -92928,64 +90490,65 @@ app_1 app_2 #f - (hasheq))))))) - (let ((module-name_0 - (1/module-path-index-resolve - (if enclosing109_0 enclosing109_0 self108_0)))) - (let ((compiled-module_0 - (let ((temp593_0 - (let ((temp600_0 - (if enclosing109_0 - (1/resolved-module-path-name - module-name_0) - #f))) - (make-compile-context.1 - temp600_0 - unsafe-undefined - enclosing109_0 - namespace107_0 - unsafe-undefined - unsafe-undefined)))) - (let ((temp594_0 - (begin-unsafe - (expand-context/inner-for-serializable? - (root-expand-context/outer-inner ctx111_0))))) - (let ((temp595_0 + (hasheq)))))) + (let ((module-name_0 + (1/module-path-index-resolve + (if enclosing109_0 enclosing109_0 self108_0)))) + (let ((compiled-module_0 + (let ((temp593_0 + (let ((temp600_0 + (if enclosing109_0 + (1/resolved-module-path-name + module-name_0) + #f))) + (make-compile-context.1 + temp600_0 + unsafe-undefined + enclosing109_0 + namespace107_0 + unsafe-undefined + unsafe-undefined)))) + (let ((temp594_0 (begin-unsafe - (expand-context/inner-to-correlated-linklet? + (expand-context/inner-for-serializable? (root-expand-context/outer-inner ctx111_0))))) - (let ((temp594_1 temp594_0) (temp593_1 temp593_0)) - (compile-module.1 - #f - modules-being-compiled112_0 - #f - temp594_1 - temp595_0 - parsed-mod_0 - temp593_1))))))) - (begin - (set-box! fill113_0 compiled-module_0) - (let ((root-module-name_0 - (resolved-module-path-root-name module-name_0))) - (with-continuation-mark* - authentic - parameterization-key - (let ((app_0 - (continuation-mark-set-first - #f - parameterization-key))) - (extend-parameterization - app_0 - 1/current-namespace - namespace107_0 - 1/current-module-declare-name - (1/make-resolved-module-path root-module-name_0))) - (eval-module.1 - unsafe-undefined - #f - #f - compiled-module_0)))))))) + (let ((temp595_0 + (begin-unsafe + (expand-context/inner-to-correlated-linklet? + (root-expand-context/outer-inner + ctx111_0))))) + (let ((temp594_1 temp594_0) (temp593_1 temp593_0)) + (compile-module.1 + #f + modules-being-compiled112_0 + #f + temp594_1 + temp595_0 + parsed-mod_0 + temp593_1))))))) + (begin + (set-box! fill113_0 compiled-module_0) + (let ((root-module-name_0 + (resolved-module-path-root-name module-name_0))) + (with-continuation-mark* + authentic + parameterization-key + (let ((app_1 + (continuation-mark-set-first + #f + parameterization-key))) + (extend-parameterization + app_1 + 1/current-namespace + namespace107_0 + 1/current-module-declare-name + (1/make-resolved-module-path root-module-name_0))) + (eval-module.1 + unsafe-undefined + #f + #f + compiled-module_0))))))))) (args (raise-binding-result-arity-error 2 args)))))))) (define attach-root-expand-context-properties (lambda (s_0 root-ctx_0 orig-self_0 new-self_0) @@ -93097,46 +90660,48 @@ #f ctx136_0 body-s_0))) - (let ((nested-bodys_0 - (let ((app_0 - (semi-parsed-begin-for-syntax-body - body_0))) - (loop_0 app_0 (add1 phase_0))))) - (let ((parsed-bfs_0 - (parsed-begin-for-syntax21.1 - rebuild-body-s_0 - (parsed-only nested-bodys_0)))) - (begin - (let ((obs_0 - (begin-unsafe - (expand-context/inner-observer - (root-expand-context/outer-inner - ctx136_0))))) - (if obs_0 - (call-expand-observe - obs_0 - 'exit-begin-for-syntax) - (void))) - (let ((app_0 - (if (begin-unsafe - (expand-context/inner-to-parsed? - (root-expand-context/outer-inner - ctx136_0))) - parsed-bfs_0 - (expanded+parsed1.1 - (let ((temp610_0 - (list* - begin-for-syntax603_0 - (syntax-only - nested-bodys_0)))) - (rebuild.1 - #t - rebuild-body-s_0 - temp610_0)) - parsed-bfs_0)))) - (cons - app_0 - (loop_0 rest-bodys_0 phase_0)))))))) + (let ((app_0 + (semi-parsed-begin-for-syntax-body + body_0))) + (let ((nested-bodys_0 + (loop_0 app_0 (add1 phase_0)))) + (let ((parsed-bfs_0 + (parsed-begin-for-syntax21.1 + rebuild-body-s_0 + (parsed-only nested-bodys_0)))) + (begin + (let ((obs_0 + (begin-unsafe + (expand-context/inner-observer + (root-expand-context/outer-inner + ctx136_0))))) + (if obs_0 + (call-expand-observe + obs_0 + 'exit-begin-for-syntax) + (void))) + (let ((app_1 + (if (begin-unsafe + (expand-context/inner-to-parsed? + (root-expand-context/outer-inner + ctx136_0))) + parsed-bfs_0 + (expanded+parsed1.1 + (let ((temp610_0 + (list* + begin-for-syntax603_0 + (syntax-only + nested-bodys_0)))) + (rebuild.1 + #t + rebuild-body-s_0 + temp610_0)) + parsed-bfs_0)))) + (cons + app_1 + (loop_0 + rest-bodys_0 + phase_0))))))))) (args (raise-binding-result-arity-error 3 args)))))) (if (let ((or-part_0 (parsed? body_0))) @@ -93618,178 +91183,100 @@ (let ((submod_0 (let ((temp656_0 (if (expand-context/outer? ctx174_0) - (let ((inner666_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - ctx174_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner + ctx174_0))) + (let ((inner666_0 (if (expand-context/inner? the-struct_0) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (root-expand-context/inner-lift-key - the-struct_0))) - (let ((app_7 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_8 - (expand-context/inner-phase - the-struct_0))) - (let ((app_9 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_10 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_11 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_12 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_13 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_14 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lifts - the-struct_0))) - (let ((app_17 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_18 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_21 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_22 - (expand-context/inner-observer - the-struct_0))) - (let ((app_23 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_24 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_25 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_26 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - empty-free-id-set - app_15 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - app_26 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + (root-expand-context/inner-lift-key + the-struct_0) + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + empty-free-id-set + (expand-context/inner-declared-submodule-names + the-struct_0) + (expand-context/inner-lifts + the-struct_0) + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0)) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-use-site-scopes - ctx174_0))) - (let ((app_1 - (root-expand-context/outer-frame-id - ctx174_0))) - (let ((app_2 - (expand-context/outer-env - ctx174_0))) - (let ((app_3 - (expand-context/outer-scopes - ctx174_0))) - (let ((app_4 - (expand-context/outer-def-ctx-scopes - ctx174_0))) - (let ((app_5 - (expand-context/outer-binding-layer - ctx174_0))) - (let ((app_6 - (expand-context/outer-reference-records - ctx174_0))) - (let ((app_7 - (expand-context/outer-only-immediate? - ctx174_0))) - (let ((app_8 - (expand-context/outer-need-eventually-defined - ctx174_0))) - (let ((app_9 - (expand-context/outer-current-introduction-scopes - ctx174_0))) - (let ((app_10 - (expand-context/outer-current-use-scopes - ctx174_0))) - (expand-context/outer1.1 - inner666_0 - #f - app_0 - app_1 - 'module - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - (expand-context/outer-name - ctx174_0)))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner666_0 + #f + (root-expand-context/outer-use-site-scopes + ctx174_0) + (root-expand-context/outer-frame-id + ctx174_0) + 'module + (expand-context/outer-env ctx174_0) + (expand-context/outer-scopes ctx174_0) + (expand-context/outer-def-ctx-scopes + ctx174_0) + (expand-context/outer-binding-layer + ctx174_0) + (expand-context/outer-reference-records + ctx174_0) + (expand-context/outer-only-immediate? + ctx174_0) + (expand-context/outer-need-eventually-defined + ctx174_0) + (expand-context/outer-current-introduction-scopes + ctx174_0) + (expand-context/outer-current-use-scopes + ctx174_0) + (expand-context/outer-name + ctx174_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -93889,102 +91376,61 @@ submod_0 (if (expanded+parsed? submod_0) (if (expanded+parsed? submod_0) - (let ((parsed680_0 - (let ((the-struct_0 - (expanded+parsed-parsed - submod_0))) + (let ((the-struct_0 + (expanded+parsed-parsed + submod_0))) + (let ((parsed680_0 (if (parsed-module? the-struct_0) - (let ((app_0 - (parsed-s - the-struct_0))) - (let ((app_1 - (parsed-module-name-id - the-struct_0))) - (let ((app_2 - (parsed-module-self - the-struct_0))) - (let ((app_3 - (parsed-module-requires - the-struct_0))) - (let ((app_4 - (parsed-module-provides - the-struct_0))) - (let ((app_5 - (parsed-module-root-ctx-simple? - the-struct_0))) - (let ((app_6 - (parsed-module-encoded-root-ctx - the-struct_0))) - (let ((app_7 - (parsed-module-body - the-struct_0))) - (let ((app_8 - (parsed-module-compiled-module - the-struct_0))) - (parsed-module25.1 - app_0 - #t - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - (parsed-module-compiled-submodules - the-struct_0))))))))))) + (parsed-module25.1 + (parsed-s the-struct_0) + #t + (parsed-module-name-id + the-struct_0) + (parsed-module-self + the-struct_0) + (parsed-module-requires + the-struct_0) + (parsed-module-provides + the-struct_0) + (parsed-module-root-ctx-simple? + the-struct_0) + (parsed-module-encoded-root-ctx + the-struct_0) + (parsed-module-body + the-struct_0) + (parsed-module-compiled-module + the-struct_0) + (parsed-module-compiled-submodules + the-struct_0)) (raise-argument-error 'struct-copy "parsed-module?" - the-struct_0))))) - (expanded+parsed1.1 - (expanded+parsed-s submod_0) - parsed680_0)) + the-struct_0)))) + (expanded+parsed1.1 + (expanded+parsed-s submod_0) + parsed680_0))) (raise-argument-error 'struct-copy "expanded+parsed?" submod_0)) (if (parsed-module? submod_0) - (let ((app_0 (parsed-s submod_0))) - (let ((app_1 - (parsed-module-name-id - submod_0))) - (let ((app_2 - (parsed-module-self - submod_0))) - (let ((app_3 - (parsed-module-requires - submod_0))) - (let ((app_4 - (parsed-module-provides - submod_0))) - (let ((app_5 - (parsed-module-root-ctx-simple? - submod_0))) - (let ((app_6 - (parsed-module-encoded-root-ctx - submod_0))) - (let ((app_7 - (parsed-module-body - submod_0))) - (let ((app_8 - (parsed-module-compiled-module - submod_0))) - (parsed-module25.1 - app_0 - #t - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - (parsed-module-compiled-submodules - submod_0))))))))))) + (parsed-module25.1 + (parsed-s submod_0) + #t + (parsed-module-name-id submod_0) + (parsed-module-self submod_0) + (parsed-module-requires submod_0) + (parsed-module-provides submod_0) + (parsed-module-root-ctx-simple? + submod_0) + (parsed-module-encoded-root-ctx + submod_0) + (parsed-module-body submod_0) + (parsed-module-compiled-module + submod_0) + (parsed-module-compiled-submodules + submod_0)) (raise-argument-error 'struct-copy "parsed-module?" @@ -94128,13 +91574,13 @@ (args (raise-binding-result-arity-error 3 args))))))))) (define defn-extract-syntax (lambda (defn_0) - (let ((app_0 - (let ((app_0 (semi-parsed-define-values-ids defn_0))) - (list - 'define-values - app_0 - (semi-parsed-define-values-rhs defn_0))))) - (datum->syntax$1 #f app_0 (semi-parsed-define-values-s defn_0))))) + (datum->syntax$1 + #f + (list + 'define-values + (semi-parsed-define-values-ids defn_0) + (semi-parsed-define-values-rhs defn_0)) + (semi-parsed-define-values-s defn_0)))) (define lifted-defns-extract-syntax (lambda (lifted-defns_0) (reverse$1 @@ -94597,7 +92043,7 @@ (args (raise-binding-result-arity-error 2 args))))) (args (raise-binding-result-arity-error 4 args)))))))))) (void))) -(define effect_2635 +(define effect_2511 (begin (void (add-core-form!* @@ -94659,182 +92105,100 @@ (make-lift-context.1 #f temp36_0)))) (let ((capture-ctx_0 (if (expand-context/outer? trans-ctx_0) - (let ((inner37_0 - (let ((the-struct_0 - (root-expand-context/outer-inner - trans-ctx_0))) + (let ((the-struct_0 + (root-expand-context/outer-inner + trans-ctx_0))) + (let ((inner37_0 (if (expand-context/inner? the-struct_0) (let ((lift-key38_0 (generate-lift-key))) - (let ((app_0 - (root-expand-context/inner-self-mpi - the-struct_0))) - (let ((app_1 - (root-expand-context/inner-module-scopes - the-struct_0))) - (let ((app_2 - (root-expand-context/inner-top-level-bind-scope - the-struct_0))) - (let ((app_3 - (root-expand-context/inner-all-scopes-stx - the-struct_0))) - (let ((app_4 - (root-expand-context/inner-defined-syms - the-struct_0))) - (let ((app_5 - (root-expand-context/inner-counter - the-struct_0))) - (let ((app_6 - (expand-context/inner-to-parsed? - the-struct_0))) - (let ((app_7 - (expand-context/inner-phase - the-struct_0))) - (let ((app_8 - (expand-context/inner-namespace - the-struct_0))) - (let ((app_9 - (expand-context/inner-just-once? - the-struct_0))) - (let ((app_10 - (expand-context/inner-module-begin-k - the-struct_0))) - (let ((app_11 - (expand-context/inner-allow-unbound? - the-struct_0))) - (let ((app_12 - (expand-context/inner-in-local-expand? - the-struct_0))) - (let ((app_13 - (|expand-context/inner-keep-#%expression?| - the-struct_0))) - (let ((app_14 - (expand-context/inner-stops - the-struct_0))) - (let ((app_15 - (expand-context/inner-declared-submodule-names - the-struct_0))) - (let ((app_16 - (expand-context/inner-lift-envs - the-struct_0))) - (let ((app_17 - (expand-context/inner-module-lifts - the-struct_0))) - (let ((app_18 - (expand-context/inner-require-lifts - the-struct_0))) - (let ((app_19 - (expand-context/inner-to-module-lifts - the-struct_0))) - (let ((app_20 - (expand-context/inner-requires+provides - the-struct_0))) - (let ((app_21 - (expand-context/inner-observer - the-struct_0))) - (let ((app_22 - (expand-context/inner-for-serializable? - the-struct_0))) - (let ((app_23 - (expand-context/inner-to-correlated-linklet? - the-struct_0))) - (let ((app_24 - (expand-context/inner-normalize-locals? - the-struct_0))) - (let ((app_25 - (expand-context/inner-parsing-expanded? - the-struct_0))) - (expand-context/inner2.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - lift-key38_0 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - app_13 - app_14 - app_15 - lift-ctx_0 - app_16 - app_17 - app_18 - app_19 - app_20 - app_21 - app_22 - app_23 - app_24 - app_25 - (expand-context/inner-skip-visit-available? - the-struct_0))))))))))))))))))))))))))))) + (expand-context/inner2.1 + (root-expand-context/inner-self-mpi + the-struct_0) + (root-expand-context/inner-module-scopes + the-struct_0) + (root-expand-context/inner-top-level-bind-scope + the-struct_0) + (root-expand-context/inner-all-scopes-stx + the-struct_0) + (root-expand-context/inner-defined-syms + the-struct_0) + (root-expand-context/inner-counter + the-struct_0) + lift-key38_0 + (expand-context/inner-to-parsed? + the-struct_0) + (expand-context/inner-phase + the-struct_0) + (expand-context/inner-namespace + the-struct_0) + (expand-context/inner-just-once? + the-struct_0) + (expand-context/inner-module-begin-k + the-struct_0) + (expand-context/inner-allow-unbound? + the-struct_0) + (expand-context/inner-in-local-expand? + the-struct_0) + (|expand-context/inner-keep-#%expression?| + the-struct_0) + (expand-context/inner-stops + the-struct_0) + (expand-context/inner-declared-submodule-names + the-struct_0) + lift-ctx_0 + (expand-context/inner-lift-envs + the-struct_0) + (expand-context/inner-module-lifts + the-struct_0) + (expand-context/inner-require-lifts + the-struct_0) + (expand-context/inner-to-module-lifts + the-struct_0) + (expand-context/inner-requires+provides + the-struct_0) + (expand-context/inner-observer + the-struct_0) + (expand-context/inner-for-serializable? + the-struct_0) + (expand-context/inner-to-correlated-linklet? + the-struct_0) + (expand-context/inner-normalize-locals? + the-struct_0) + (expand-context/inner-parsing-expanded? + the-struct_0) + (expand-context/inner-skip-visit-available? + the-struct_0))) (raise-argument-error 'struct-copy "expand-context/inner?" - the-struct_0))))) - (let ((app_0 - (root-expand-context/outer-post-expansion - trans-ctx_0))) - (let ((app_1 - (root-expand-context/outer-use-site-scopes - trans-ctx_0))) - (let ((app_2 - (root-expand-context/outer-frame-id - trans-ctx_0))) - (let ((app_3 - (expand-context/outer-context - trans-ctx_0))) - (let ((app_4 - (expand-context/outer-env - trans-ctx_0))) - (let ((app_5 - (expand-context/outer-scopes - trans-ctx_0))) - (let ((app_6 - (expand-context/outer-def-ctx-scopes - trans-ctx_0))) - (let ((app_7 - (expand-context/outer-binding-layer - trans-ctx_0))) - (let ((app_8 - (expand-context/outer-reference-records - trans-ctx_0))) - (let ((app_9 - (expand-context/outer-only-immediate? - trans-ctx_0))) - (let ((app_10 - (expand-context/outer-need-eventually-defined - trans-ctx_0))) - (let ((app_11 - (expand-context/outer-current-introduction-scopes - trans-ctx_0))) - (let ((app_12 - (expand-context/outer-current-use-scopes - trans-ctx_0))) - (expand-context/outer1.1 - inner37_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - app_10 - app_11 - app_12 - (expand-context/outer-name - trans-ctx_0)))))))))))))))) + the-struct_0)))) + (expand-context/outer1.1 + inner37_0 + (root-expand-context/outer-post-expansion + trans-ctx_0) + (root-expand-context/outer-use-site-scopes + trans-ctx_0) + (root-expand-context/outer-frame-id + trans-ctx_0) + (expand-context/outer-context trans-ctx_0) + (expand-context/outer-env trans-ctx_0) + (expand-context/outer-scopes trans-ctx_0) + (expand-context/outer-def-ctx-scopes + trans-ctx_0) + (expand-context/outer-binding-layer + trans-ctx_0) + (expand-context/outer-reference-records + trans-ctx_0) + (expand-context/outer-only-immediate? + trans-ctx_0) + (expand-context/outer-need-eventually-defined + trans-ctx_0) + (expand-context/outer-current-introduction-scopes + trans-ctx_0) + (expand-context/outer-current-use-scopes + trans-ctx_0) + (expand-context/outer-name trans-ctx_0)))) (raise-argument-error 'struct-copy "expand-context/outer?" @@ -94902,11 +92266,14 @@ #f temp40_0 capture-ctx_0)))) - (loop_1 - (cdr forms_1) - (cons - exp-form_0 - accum_0)))))))))) + (let ((app_0 + (cdr + forms_1))) + (loop_1 + app_0 + (cons + exp-form_0 + accum_0))))))))))) (loop_1 forms_0 null)))) (let ((lifts_0 (begin-unsafe @@ -94927,28 +92294,28 @@ 'module-lift-loop lifts_0) (void))) - (let ((beg_0 - (let ((temp44_0 - (begin-unsafe - (expand-context/inner-phase - (root-expand-context/outer-inner - trans-ctx_0))))) + (let ((temp44_0 + (begin-unsafe + (expand-context/inner-phase + (root-expand-context/outer-inner + trans-ctx_0))))) + (let ((beg_0 (wrap-lifts-as-begin.1 unsafe-undefined unsafe-undefined lifts_0 #f - temp44_0)))) - (let ((exprs_0 - (reverse$1 - (cdr + temp44_0))) + (let ((exprs_0 (reverse$1 (cdr - (syntax-e$1 - beg_0))))))) - (append - (loop_0 exprs_0) - exp-forms_0))))))))))))) + (reverse$1 + (cdr + (syntax-e$1 + beg_0))))))) + (append + (loop_0 exprs_0) + exp-forms_0)))))))))))))) (loop_0 form30_0)))) (if (begin-unsafe (expand-context/inner-to-parsed? @@ -95293,7 +92660,7 @@ (declare-reexporting-module!.1 ns_0 #f '|#%builtin| temp41_0)) (1/current-namespace ns_0) (1/dynamic-require ''|#%kernel| 0)))))) -(define effect_2374 +(define effect_2376 (begin (|#%call-with-values| (lambda () (namespace-init!)) print-values) (void))) diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 5a4d7a23d1..c5bbd7e316 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -569,18 +569,20 @@ keyword-procedure? keyword-procedure-ref keyword-procedure-set!) - (make-struct-type - 'keyword-procedure - #f - 4 - 0 - #f - (list - (cons prop:checked-procedure #t) - (cons prop:impersonator-of keyword-procedure-impersonator-of)) - (current-inspector) - #f - '(0 1 2 3))) + (let ((app_0 + (list + (cons prop:checked-procedure #t) + (cons prop:impersonator-of keyword-procedure-impersonator-of)))) + (make-struct-type + 'keyword-procedure + #f + 4 + 0 + #f + app_0 + (current-inspector) + #f + '(0 1 2 3)))) (define keyword-procedure-required (make-struct-field-accessor keyword-procedure-ref 2)) (define keyword-procedure-allowed @@ -3681,7 +3683,7 @@ (begin (unsafe-place-local-set! cell.1$10 sleep_0) (unsafe-place-local-set! cell.2$3 fd_0)))) -(define effect_2807 +(define effect_2066 (begin (void (|#%app| @@ -3784,8 +3786,10 @@ (if or-part_0 or-part_0 (null? fd-adders_0))) (void) (internal-error "cannot sleep on fds")) - (let ((app_0 (sandman-do-add-thread! timeout-sandman_0))) - (|#%app| app_0 t_0 (exts-timeout-at exts_0)))))) + (|#%app| + (sandman-do-add-thread! timeout-sandman_0) + t_0 + (exts-timeout-at exts_0))))) (lambda (t_0 timeout-handle_0) (|#%app| (sandman-do-remove-thread! timeout-sandman_0) @@ -3794,16 +3798,14 @@ (lambda (a-exts_0 b-exts_0) (if (if a-exts_0 b-exts_0 #f) (let ((app_0 - (let ((app_0 - (sandman-do-merge-external-event-sets - timeout-sandman_0))) - (let ((app_1 (exts-timeout-at a-exts_0))) - (|#%app| app_0 app_1 (exts-timeout-at b-exts_0)))))) + (|#%app| + (sandman-do-merge-external-event-sets timeout-sandman_0) + (exts-timeout-at a-exts_0) + (exts-timeout-at b-exts_0)))) (exts1.1 app_0 (if (if (exts-fd-adders a-exts_0) (exts-fd-adders b-exts_0) #f) - (let ((app_1 (exts-fd-adders a-exts_0))) - (cons app_1 (exts-fd-adders b-exts_0))) + (cons (exts-fd-adders a-exts_0) (exts-fd-adders b-exts_0)) (let ((or-part_0 (exts-fd-adders a-exts_0))) (if or-part_0 or-part_0 (exts-fd-adders b-exts_0)))))) (if a-exts_0 a-exts_0 b-exts_0))) @@ -4403,36 +4405,26 @@ 'core-input-port-methods 'commit)))))) (define core-input-port-vtable.1 - (let ((app_0 (core-port-methods-close.1 core-port-vtable.1))) - (let ((app_1 (core-port-methods-count-lines!.1 core-port-vtable.1))) - (let ((app_2 (core-port-methods-get-location.1 core-port-vtable.1))) - (let ((app_3 (core-port-methods-file-position.1 core-port-vtable.1))) - (core-input-port-methods6.1 - app_0 - app_1 - app_2 - app_3 - (core-port-methods-buffer-mode.1 core-port-vtable.1) - #f - (|#%name| - read-in - (lambda (this-id_0 bstr13_0 start14_0 end15_0 copy?16_0) - (begin eof))) - (|#%name| - peek-in - (lambda (this-id_0 - bstr30_0 - start31_0 - end32_0 - progress-evt33_0 - copy?34_0) - (begin eof))) - (|#%name| byte-ready (lambda (this-id_0 work-done!49_0) (begin #t))) - #f - (|#%name| - commit - (lambda (this-id_0 amt60_0 progress-evt61_0 ext-evt62_0 finish63_0) - (begin #f))))))))) + (core-input-port-methods6.1 + (core-port-methods-close.1 core-port-vtable.1) + (core-port-methods-count-lines!.1 core-port-vtable.1) + (core-port-methods-get-location.1 core-port-vtable.1) + (core-port-methods-file-position.1 core-port-vtable.1) + (core-port-methods-buffer-mode.1 core-port-vtable.1) + #f + (|#%name| + read-in + (lambda (this-id_0 bstr13_0 start14_0 end15_0 copy?16_0) (begin eof))) + (|#%name| + peek-in + (lambda (this-id_0 bstr30_0 start31_0 end32_0 progress-evt33_0 copy?34_0) + (begin eof))) + (|#%name| byte-ready (lambda (this-id_0 work-done!49_0) (begin #t))) + #f + (|#%name| + commit + (lambda (this-id_0 amt60_0 progress-evt61_0 ext-evt62_0 finish63_0) + (begin #f))))) (define empty-input-port (create-core-input-port core-input-port-vtable.1 @@ -4687,32 +4679,27 @@ 'core-output-port-methods 'get-write-special-evt)))))) (define core-output-port-vtable.1 - (let ((app_0 (core-port-methods-close.1 core-port-vtable.1))) - (let ((app_1 (core-port-methods-count-lines!.1 core-port-vtable.1))) - (let ((app_2 (core-port-methods-get-location.1 core-port-vtable.1))) - (let ((app_3 (core-port-methods-file-position.1 core-port-vtable.1))) - (core-output-port-methods6.1 - app_0 - app_1 - app_2 - app_3 - (core-port-methods-buffer-mode.1 core-port-vtable.1) - (|#%name| - write-out - (lambda (this-id_0 - bstr14_0 - start-k15_0 - end-k16_0 - no-block/buffer?17_0 - enable-break?18_0 - copy?19_0) - (begin (- end-k16_0 start-k15_0)))) - #f - (|#%name| - get-write-evt - (lambda (this-id_0 bstr37_0 start-k38_0 end-k39_0) - (begin always-evt))) - #f)))))) + (core-output-port-methods6.1 + (core-port-methods-close.1 core-port-vtable.1) + (core-port-methods-count-lines!.1 core-port-vtable.1) + (core-port-methods-get-location.1 core-port-vtable.1) + (core-port-methods-file-position.1 core-port-vtable.1) + (core-port-methods-buffer-mode.1 core-port-vtable.1) + (|#%name| + write-out + (lambda (this-id_0 + bstr14_0 + start-k15_0 + end-k16_0 + no-block/buffer?17_0 + enable-break?18_0 + copy?19_0) + (begin (- end-k16_0 start-k15_0)))) + #f + (|#%name| + get-write-evt + (lambda (this-id_0 bstr37_0 start-k38_0 end-k39_0) (begin always-evt))) + #f)) (define get-write-evt-via-write-out (lambda (count-write-evt-via-write-out_0) (lambda (out_0 src-bstr_0 src-start_0 src-end_0) @@ -6276,9 +6263,10 @@ (core-port-vtable p_1)))) (if get-location_0 (|#%app| get-location_0 p_1) - (let ((app_0 (location-line loc_0))) - (let ((app_1 (location-column loc_0))) - (values app_0 app_1 (location-position loc_0))))))) + (values + (location-line loc_0) + (location-column loc_0) + (location-position loc_0))))) (unsafe-end-atomic))) (if (core-port-methods-file-position.1 (core-port-vtable p_1)) (let ((offset_0 @@ -6535,18 +6523,14 @@ (if position_0 (add1 position_0) #f) state_0 #f))))))))))))))))) - (let ((app_0 (location-line loc_0))) - (let ((app_1 (location-column loc_0))) - (let ((app_2 (location-position loc_0))) - (let ((app_3 (location-state loc_0))) - (loop_0 - start_0 - 0 - app_0 - app_1 - app_2 - app_3 - (location-cr-state loc_0)))))))) + (loop_0 + start_0 + 0 + (location-line loc_0) + (location-column loc_0) + (location-position loc_0) + (location-state loc_0) + (location-cr-state loc_0)))) (void)))))) (define port-count-all! (lambda (in_0 extra-ins_0 amt_0 bstr_0 start_0) @@ -6591,14 +6575,13 @@ (port-count! in_0 1 (bytes b_0) 0) (let ((column_0 (location-column loc_0))) (let ((position_0 (location-position loc_0))) - (let ((column_1 column_0)) - (begin - (if position_0 - (set-location-position! loc_0 (add1 position_0)) - (void)) - (if column_1 - (set-location-column! loc_0 (add1 column_1)) - (void))))))) + (begin + (if position_0 + (set-location-position! loc_0 (add1 position_0)) + (void)) + (if column_0 + (set-location-column! loc_0 (add1 column_0)) + (void)))))) (void)))))) (define port-count-byte-all! (lambda (in_0 extra-ins_0 b_0) @@ -7229,42 +7212,18 @@ (commit-input-port-methods?.1_1864 (impersonator-val v)) #f)))))) (define commit-input-port-vtable.1 - (let ((app_0 (core-port-methods-close.1 core-input-port-vtable.1))) - (let ((app_1 (core-port-methods-count-lines!.1 core-input-port-vtable.1))) - (let ((app_2 - (core-port-methods-get-location.1 core-input-port-vtable.1))) - (let ((app_3 - (core-port-methods-file-position.1 core-input-port-vtable.1))) - (let ((app_4 - (core-port-methods-buffer-mode.1 core-input-port-vtable.1))) - (let ((app_5 - (core-input-port-methods-prepare-change.1 - core-input-port-vtable.1))) - (let ((app_6 - (core-input-port-methods-read-in.1 - core-input-port-vtable.1))) - (let ((app_7 - (core-input-port-methods-peek-in.1 - core-input-port-vtable.1))) - (let ((app_8 - (core-input-port-methods-byte-ready.1 - core-input-port-vtable.1))) - (let ((app_9 - (core-input-port-methods-get-progress-evt.1 - core-input-port-vtable.1))) - (commit-input-port-methods5.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - app_8 - app_9 - (core-input-port-methods-commit.1 - core-input-port-vtable.1))))))))))))) + (commit-input-port-methods5.1 + (core-port-methods-close.1 core-input-port-vtable.1) + (core-port-methods-count-lines!.1 core-input-port-vtable.1) + (core-port-methods-get-location.1 core-input-port-vtable.1) + (core-port-methods-file-position.1 core-input-port-vtable.1) + (core-port-methods-buffer-mode.1 core-input-port-vtable.1) + (core-input-port-methods-prepare-change.1 core-input-port-vtable.1) + (core-input-port-methods-read-in.1 core-input-port-vtable.1) + (core-input-port-methods-peek-in.1 core-input-port-vtable.1) + (core-input-port-methods-byte-ready.1 core-input-port-vtable.1) + (core-input-port-methods-get-progress-evt.1 core-input-port-vtable.1) + (core-input-port-methods-commit.1 core-input-port-vtable.1))) (define temp1.1 (|#%name| progress! @@ -7530,9 +7489,7 @@ (|#%name| input-empty? (lambda (this-id_0) - (begin - (let ((app_0 (pipe-data-start this-id_0))) - (fx= app_0 (pipe-data-end this-id_0))))))) + (begin (fx= (pipe-data-start this-id_0) (pipe-data-end this-id_0)))))) (define temp6.1$2 (|#%name| output-full? @@ -7659,273 +7616,255 @@ (pipe-input-port-methods?.1_2609 (impersonator-val v)) #f)))))) (define pipe-input-port-vtable.1 - (let ((app_0 (core-port-methods-get-location.1 commit-input-port-vtable.1))) - (let ((app_1 - (core-port-methods-file-position.1 commit-input-port-vtable.1))) - (pipe-input-port-methods15.1 - (|#%name| - close - (lambda (this-id_0) - (begin - (let ((o_0 (pipe-input-port-d this-id_0))) - (if (pipe-data-input-ref o_0) - (begin - (|#%app| temp12.1 this-id_0) - (set-pipe-data-input-ref! o_0 #f) - (temp1.1 this-id_0) - (temp8.1$1 o_0) - (temp7.1$2 o_0)) - (void)))))) - (|#%name| - count-lines! - (lambda (this-id_0) (begin (|#%app| temp12.1 this-id_0)))) - app_0 - app_1 - (core-port-methods-buffer-mode.1 commit-input-port-vtable.1) - (|#%name| - prepare-change - (lambda (this-id_0) - (begin - (let ((o_0 (pipe-input-port-d this-id_0))) (temp2.1 this-id_0))))) - (|#%name| - read-in - (lambda (this-id_0 - dest-bstr396_0 - dest-start397_0 - dest-end398_0 - copy?399_0) - (begin + (pipe-input-port-methods15.1 + (|#%name| + close + (lambda (this-id_0) + (begin + (let ((o_0 (pipe-input-port-d this-id_0))) + (if (pipe-data-input-ref o_0) (begin - (begin-unsafe (void)) - (|#%app| temp12.1 this-id_0) - (let ((o_0 (pipe-input-port-d this-id_0))) - (if (temp5.1$2 o_0) - (if (pipe-data-output-ref o_0) - (pipe-data-read-ready-evt o_0) - eof) - (begin - (temp7.1$2 o_0) - (let ((s_0 (pipe-data-start o_0))) - (let ((e_0 (pipe-data-end o_0))) - (let ((amt_0 - (if (fx< s_0 e_0) - (let ((amt_0 - (let ((app_2 - (fx- - dest-end398_0 - dest-start397_0))) - (fxmin app_2 (fx- e_0 s_0))))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr396_0 - dest-start397_0 - app_2 - s_0 - (fx+ s_0 amt_0))) - (set-pipe-data-start! o_0 (fx+ s_0 amt_0)) - (set-pipe-data-peeked-amt! - o_0 - (fxmax - 0 - (fx- (pipe-data-peeked-amt o_0) amt_0))) - amt_0)) - (let ((amt_0 - (let ((app_2 - (fx- - dest-end398_0 - dest-start397_0))) - (fxmin - app_2 - (fx- (pipe-data-len o_0) s_0))))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr396_0 - dest-start397_0 - app_2 - s_0 - (fx+ s_0 amt_0))) - (set-pipe-data-start! - o_0 - (let ((app_2 (fx+ s_0 amt_0))) - (modulo app_2 (pipe-data-len o_0)))) - (set-pipe-data-peeked-amt! - o_0 - (fxmax - 0 - (fx- (pipe-data-peeked-amt o_0) amt_0))) - amt_0))))) - (begin - (temp1.1 this-id_0) - (|#%app| temp11.1 this-id_0 amt_0) - amt_0))))))))))) - (|#%name| - peek-in - (lambda (this-id_0 - dest-bstr448_0 - dest-start449_0 - dest-end450_0 - skip451_0 - progress-evt452_0 - copy?453_0) - (begin - (let ((o_0 (pipe-input-port-d this-id_0))) + (temp12.1 this-id_0) + (set-pipe-data-input-ref! o_0 #f) + (temp1.1 this-id_0) + (temp8.1$1 o_0) + (temp7.1$2 o_0)) + (void)))))) + (|#%name| count-lines! (lambda (this-id_0) (begin (temp12.1 this-id_0)))) + (core-port-methods-get-location.1 commit-input-port-vtable.1) + (core-port-methods-file-position.1 commit-input-port-vtable.1) + (core-port-methods-buffer-mode.1 commit-input-port-vtable.1) + (|#%name| + prepare-change + (lambda (this-id_0) + (begin (let ((o_0 (pipe-input-port-d this-id_0))) (temp2.1 this-id_0))))) + (|#%name| + read-in + (lambda (this-id_0 dest-bstr396_0 dest-start397_0 dest-end398_0 copy?399_0) + (begin + (begin + (begin-unsafe (void)) + (temp12.1 this-id_0) + (let ((o_0 (pipe-input-port-d this-id_0))) + (if (temp5.1$2 o_0) + (if (pipe-data-output-ref o_0) + (pipe-data-read-ready-evt o_0) + eof) (begin - (temp3.1$3 o_0) - (let ((content-amt_0 (temp4.1$2 o_0))) - (if (if progress-evt452_0 - (sync/timeout 0 progress-evt452_0) - #f) - #f - (if (<= content-amt_0 skip451_0) - (if (not (pipe-data-output-ref o_0)) - eof - (begin - (if (let ((or-part_0 (zero? skip451_0))) - (if or-part_0 - or-part_0 - (pipe-data-more-read-ready-sema o_0))) - (void) - (begin - (set-pipe-data-more-read-ready-sema! - o_0 - (make-semaphore)) - (let ((out_0 - (let ((r_0 (pipe-data-output-ref o_0))) - (begin-unsafe (weak-box-value r_0))))) - (if out_0 (|#%app| temp19.1$1 out_0) (void))))) - (let ((evt_0 - (if (zero? skip451_0) - (pipe-data-read-ready-evt o_0) - (wrap-evt - (semaphore-peek-evt - (pipe-data-more-read-ready-sema o_0)) - (lambda (v_0) 0))))) - evt_0))) - (let ((peek-start_0 - (let ((app_2 - (fx+ (pipe-data-start o_0) skip451_0))) - (fxmodulo app_2 (pipe-data-len o_0))))) - (if (fx< peek-start_0 (pipe-data-end o_0)) - (let ((amt_0 - (let ((app_2 - (fx- dest-end450_0 dest-start449_0))) - (fxmin - app_2 - (fx- (pipe-data-end o_0) peek-start_0))))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr448_0 - dest-start449_0 - app_2 - peek-start_0 - (fx+ peek-start_0 amt_0))) - (temp9.1$1 o_0 (+ skip451_0 amt_0)) - amt_0)) - (let ((amt_0 - (let ((app_2 - (fx- dest-end450_0 dest-start449_0))) - (fxmin - app_2 - (fx- (pipe-data-len o_0) peek-start_0))))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr448_0 - dest-start449_0 - app_2 - peek-start_0 - (fx+ peek-start_0 amt_0))) - (temp9.1$1 o_0 (+ skip451_0 amt_0)) - amt_0)))))))))))) - (|#%name| - byte-ready - (lambda (this-id_0 work-done!504_0) + (temp7.1$2 o_0) + (let ((s_0 (pipe-data-start o_0))) + (let ((e_0 (pipe-data-end o_0))) + (let ((amt_0 + (if (fx< s_0 e_0) + (let ((amt_0 + (let ((app_0 + (fx- + dest-end398_0 + dest-start397_0))) + (fxmin app_0 (fx- e_0 s_0))))) + (begin + (let ((app_0 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr396_0 + dest-start397_0 + app_0 + s_0 + (fx+ s_0 amt_0))) + (set-pipe-data-start! o_0 (fx+ s_0 amt_0)) + (set-pipe-data-peeked-amt! + o_0 + (fxmax + 0 + (fx- (pipe-data-peeked-amt o_0) amt_0))) + amt_0)) + (let ((amt_0 + (let ((app_0 + (fx- + dest-end398_0 + dest-start397_0))) + (fxmin + app_0 + (fx- (pipe-data-len o_0) s_0))))) + (begin + (let ((app_0 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr396_0 + dest-start397_0 + app_0 + s_0 + (fx+ s_0 amt_0))) + (set-pipe-data-start! + o_0 + (let ((app_0 (fx+ s_0 amt_0))) + (modulo app_0 (pipe-data-len o_0)))) + (set-pipe-data-peeked-amt! + o_0 + (fxmax + 0 + (fx- (pipe-data-peeked-amt o_0) amt_0))) + amt_0))))) + (begin + (temp1.1 this-id_0) + (temp11.1 this-id_0 amt_0) + amt_0))))))))))) + (|#%name| + peek-in + (lambda (this-id_0 + dest-bstr448_0 + dest-start449_0 + dest-end450_0 + skip451_0 + progress-evt452_0 + copy?453_0) + (begin + (let ((o_0 (pipe-input-port-d this-id_0))) (begin - (begin - (begin-unsafe (void)) - (let ((o_0 (pipe-input-port-d this-id_0))) - (let ((or-part_0 (not (pipe-data-output-ref o_0)))) - (if or-part_0 - or-part_0 + (temp3.1$3 o_0) + (let ((content-amt_0 (temp4.1$2 o_0))) + (if (if progress-evt452_0 (sync/timeout 0 progress-evt452_0) #f) + #f + (if (<= content-amt_0 skip451_0) + (if (not (pipe-data-output-ref o_0)) + eof (begin - (temp3.1$3 o_0) - (not (fx= 0 (temp4.1$2 o_0))))))))))) - (|#%name| - get-progress-evt - (lambda (this-id_0) - (begin - (begin - (unsafe-start-atomic) - (begin0 - (let ((o_0 (pipe-input-port-d this-id_0))) - (if (not (pipe-data-input-ref o_0)) - always-evt - (begin (|#%app| temp12.1 this-id_0) (temp4.1 this-id_0)))) - (unsafe-end-atomic)))))) - (|#%name| - commit - (lambda (this-id_0 amt594_0 progress-evt595_0 ext-evt596_0 finish597_0) - (begin - (begin - (begin-unsafe (void)) - (if (zero? amt594_0) - (temp1.1 this-id_0) - (temp3.1 - this-id_0 - progress-evt595_0 - ext-evt596_0 - (lambda () - (let ((o_0 (pipe-input-port-d this-id_0))) - (begin - (|#%app| temp12.1 this-id_0) - (let ((amt_0 (min amt594_0 (temp4.1$2 o_0)))) - (if (fx= 0 amt_0) - (|#%app| finish597_0 #vu8()) - (let ((dest-bstr_0 (make-bytes amt_0))) - (let ((s_0 (pipe-data-start o_0))) - (let ((e_0 (pipe-data-end o_0))) - (begin - (if (fx< s_0 e_0) - (let ((app_2 (pipe-data-bstr o_0))) + (if (let ((or-part_0 (zero? skip451_0))) + (if or-part_0 + or-part_0 + (pipe-data-more-read-ready-sema o_0))) + (void) + (begin + (set-pipe-data-more-read-ready-sema! + o_0 + (make-semaphore)) + (let ((r_0 (pipe-data-output-ref o_0))) + (let ((out_0 (begin-unsafe (weak-box-value r_0)))) + (if out_0 (temp19.1$1 out_0) (void)))))) + (let ((evt_0 + (if (zero? skip451_0) + (pipe-data-read-ready-evt o_0) + (wrap-evt + (semaphore-peek-evt + (pipe-data-more-read-ready-sema o_0)) + (lambda (v_0) 0))))) + evt_0))) + (let ((peek-start_0 + (let ((app_0 (fx+ (pipe-data-start o_0) skip451_0))) + (fxmodulo app_0 (pipe-data-len o_0))))) + (if (fx< peek-start_0 (pipe-data-end o_0)) + (let ((amt_0 + (let ((app_0 (fx- dest-end450_0 dest-start449_0))) + (fxmin + app_0 + (fx- (pipe-data-end o_0) peek-start_0))))) + (begin + (let ((app_0 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr448_0 + dest-start449_0 + app_0 + peek-start_0 + (fx+ peek-start_0 amt_0))) + (temp9.1$1 o_0 (+ skip451_0 amt_0)) + amt_0)) + (let ((amt_0 + (let ((app_0 (fx- dest-end450_0 dest-start449_0))) + (fxmin + app_0 + (fx- (pipe-data-len o_0) peek-start_0))))) + (begin + (let ((app_0 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr448_0 + dest-start449_0 + app_0 + peek-start_0 + (fx+ peek-start_0 amt_0))) + (temp9.1$1 o_0 (+ skip451_0 amt_0)) + amt_0)))))))))))) + (|#%name| + byte-ready + (lambda (this-id_0 work-done!504_0) + (begin + (begin + (begin-unsafe (void)) + (let ((o_0 (pipe-input-port-d this-id_0))) + (let ((or-part_0 (not (pipe-data-output-ref o_0)))) + (if or-part_0 + or-part_0 + (begin (temp3.1$3 o_0) (not (fx= 0 (temp4.1$2 o_0))))))))))) + (|#%name| + get-progress-evt + (lambda (this-id_0) + (begin + (begin + (unsafe-start-atomic) + (begin0 + (let ((o_0 (pipe-input-port-d this-id_0))) + (if (not (pipe-data-input-ref o_0)) + always-evt + (begin (temp12.1 this-id_0) (temp4.1 this-id_0)))) + (unsafe-end-atomic)))))) + (|#%name| + commit + (lambda (this-id_0 amt594_0 progress-evt595_0 ext-evt596_0 finish597_0) + (begin + (begin + (begin-unsafe (void)) + (if (zero? amt594_0) + (temp1.1 this-id_0) + (temp3.1 + this-id_0 + progress-evt595_0 + ext-evt596_0 + (lambda () + (let ((o_0 (pipe-input-port-d this-id_0))) + (begin + (temp12.1 this-id_0) + (let ((amt_0 (min amt594_0 (temp4.1$2 o_0)))) + (if (fx= 0 amt_0) + (|#%app| finish597_0 #vu8()) + (let ((dest-bstr_0 (make-bytes amt_0))) + (let ((s_0 (pipe-data-start o_0))) + (let ((e_0 (pipe-data-end o_0))) + (begin + (if (fx< s_0 e_0) + (let ((app_0 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr_0 + 0 + app_0 + s_0 + (fx+ s_0 amt_0))) + (let ((amt1_0 + (fxmin + (fx- (pipe-data-len o_0) s_0) + amt_0))) + (begin + (let ((app_0 (pipe-data-bstr o_0))) (unsafe-bytes-copy! dest-bstr_0 0 - app_2 + app_0 s_0 - (fx+ s_0 amt_0))) - (let ((amt1_0 - (fxmin - (fx- (pipe-data-len o_0) s_0) - amt_0))) - (begin - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr_0 - 0 - app_2 - s_0 - (fx+ s_0 amt1_0))) - (if (fx< amt1_0 amt_0) - (let ((app_2 (pipe-data-bstr o_0))) - (unsafe-bytes-copy! - dest-bstr_0 - amt1_0 - app_2 - 0 - (fx- amt_0 amt1_0))) - (void))))) - (set-pipe-data-start! - o_0 - (let ((app_2 (fx+ s_0 amt_0))) - (fxmodulo app_2 (pipe-data-len o_0)))) - (temp1.1 this-id_0) - (|#%app| temp11.1 this-id_0 amt_0) - (|#%app| - finish597_0 - dest-bstr_0)))))))))))))))))))) + (fx+ s_0 amt1_0))) + (if (fx< amt1_0 amt_0) + (let ((app_0 (pipe-data-bstr o_0))) + (unsafe-bytes-copy! + dest-bstr_0 + amt1_0 + app_0 + 0 + (fx- amt_0 amt1_0))) + (void))))) + (set-pipe-data-start! + o_0 + (let ((app_0 (fx+ s_0 amt_0))) + (fxmodulo app_0 (pipe-data-len o_0)))) + (temp1.1 this-id_0) + (temp11.1 this-id_0 amt_0) + (|#%app| + finish597_0 + dest-bstr_0)))))))))))))))))) (define temp13.1 (|#%name| on-resize (lambda (this-id_0) (begin (temp12.1 this-id_0))))) (define temp14.1 @@ -8125,109 +8064,95 @@ (if or-part_0 or-part_0 (let ((app_6 - (let ((app_6 - (pipe-data-limit - o_0))) - (+ - app_6 - (pipe-data-peeked-amt - o_0))))) + (+ + (pipe-data-limit o_0) + (pipe-data-peeked-amt + o_0)))) (> app_6 (fx- (pipe-data-len o_0) 1))))) - (let ((in_0 - (let ((r_0 - (pipe-data-input-ref - o_0))) + (let ((r_0 + (pipe-data-input-ref o_0))) + (let ((in_0 (begin-unsafe - (weak-box-value r_0))))) - (begin - (if in_0 - (temp13.1 in_0) - (void)) - (let ((new-bstr_0 - (make-bytes - (let ((app_6 - (if (pipe-data-limit - o_0) - (let ((app_6 - (pipe-data-limit - o_0))) + (weak-box-value r_0)))) + (begin + (if in_0 + (temp13.1 in_0) + (void)) + (let ((new-bstr_0 + (make-bytes + (let ((app_6 + (if (pipe-data-limit + o_0) (+ - app_6 + (pipe-data-limit + o_0) (pipe-data-peeked-amt - o_0))) - #f))) - (min+1 - app_6 - (* - (pipe-data-len o_0) - 2)))))) - (begin - (if (fx= - 0 - (pipe-data-start o_0)) - (let ((app_6 - (pipe-data-bstr - o_0))) - (unsafe-bytes-copy! - new-bstr_0 - 0 - app_6 - 0 - (fx- - (pipe-data-len o_0) - 1))) - (begin + o_0)) + #f))) + (min+1 + app_6 + (* + (pipe-data-len + o_0) + 2)))))) + (begin + (if (fx= + 0 + (pipe-data-start + o_0)) (let ((app_6 (pipe-data-bstr o_0))) - (let ((app_7 - (pipe-data-start - o_0))) - (unsafe-bytes-copy! - new-bstr_0 - 0 - app_6 - app_7 - (pipe-data-len - o_0)))) - (let ((app_6 - (let ((app_6 - (pipe-data-len - o_0))) + (unsafe-bytes-copy! + new-bstr_0 + 0 + app_6 + 0 + (fx- + (pipe-data-len o_0) + 1))) + (begin + (unsafe-bytes-copy! + new-bstr_0 + 0 + (pipe-data-bstr o_0) + (pipe-data-start + o_0) + (pipe-data-len o_0)) + (let ((app_6 (fx- - app_6 + (pipe-data-len + o_0) (pipe-data-start - o_0))))) - (let ((app_7 - (pipe-data-bstr - o_0))) + o_0)))) (unsafe-bytes-copy! new-bstr_0 app_6 - app_7 + (pipe-data-bstr + o_0) 0 (pipe-data-end - o_0)))) - (set-pipe-data-start! - o_0 - 0) - (set-pipe-data-end! - o_0 - (fx- - (pipe-data-len o_0) - 1)))) - (set-pipe-data-bstr! - o_0 - new-bstr_0) - (set-pipe-data-len! - o_0 - (unsafe-bytes-length - new-bstr_0)) - (try-again_0))))) + o_0))) + (set-pipe-data-start! + o_0 + 0) + (set-pipe-data-end! + o_0 + (fx- + (pipe-data-len o_0) + 1)))) + (set-pipe-data-bstr! + o_0 + new-bstr_0) + (set-pipe-data-len! + o_0 + (unsafe-bytes-length + new-bstr_0)) + (try-again_0)))))) (pipe-is-full_0)))))) (pipe-is-full_0 (|#%name| @@ -8246,24 +8171,19 @@ (min amt_0 (let ((app_6 - (let ((app_6 - (pipe-data-limit - o_0))) - (+ - app_6 - (pipe-data-peeked-amt - o_0))))) + (+ + (pipe-data-limit o_0) + (pipe-data-peeked-amt + o_0)))) (- app_6 (temp4.1$2 o_0)))) amt_0)))))) (if (fx= src-start819_0 src-end820_0) 0 (if (not (pipe-data-input-ref o_0)) (fx- src-end820_0 src-start819_0) - (if (if (let ((app_6 - (pipe-data-end o_0))) - (fx>= - app_6 - (pipe-data-start o_0))) + (if (if (fx>= + (pipe-data-end o_0) + (pipe-data-start o_0)) (fx< (pipe-data-end o_0) top-pos_0) @@ -8591,7 +8511,7 @@ ((limit24_0) (make-pipe_0 limit24_0 'pipe 'pipe)))))) (define struct:pipe-write-poller (make-record-type-descriptor* 'pipe-write-poller #f #f #f #f 1 0)) -(define effect_2371 +(define effect_2873 (struct-type-install-properties! struct:pipe-write-poller 'pipe-write-poller @@ -8619,16 +8539,15 @@ (if (pipe-data-write-ready-sema o_0) (void) (set-pipe-data-write-ready-sema! o_0 (make-semaphore))) - (let ((in_0 - (let ((r_0 (pipe-data-input-ref o_0))) - (begin-unsafe (weak-box-value r_0))))) - (begin - (if in_0 (temp14.1 in_0) (void)) - (values - #f - (replace-evt - (semaphore-peek-evt (pipe-data-write-ready-sema o_0)) - (lambda (v_0) pwp_0))))))))))))) + (let ((r_0 (pipe-data-input-ref o_0))) + (let ((in_0 (begin-unsafe (weak-box-value r_0)))) + (begin + (if in_0 (temp14.1 in_0) (void)) + (values + #f + (replace-evt + (semaphore-peek-evt (pipe-data-write-ready-sema o_0)) + (lambda (v_0) pwp_0)))))))))))))) (current-inspector) #f '(0) @@ -8669,7 +8588,7 @@ 'd)))))) (define struct:pipe-read-poller (make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 0)) -(define effect_2439 +(define effect_2386 (struct-type-install-properties! struct:pipe-read-poller 'pipe-read-poller @@ -8697,16 +8616,15 @@ (if (pipe-data-read-ready-sema o_0) (void) (set-pipe-data-read-ready-sema! o_0 (make-semaphore))) - (let ((out_0 - (let ((r_0 (pipe-data-output-ref o_0))) - (begin-unsafe (weak-box-value r_0))))) - (begin - (if out_0 (temp18.1$1 out_0) (void)) - (values - #f - (wrap-evt - (semaphore-peek-evt (pipe-data-read-ready-sema o_0)) - (lambda (v_0) 0))))))))))))) + (let ((r_0 (pipe-data-output-ref o_0))) + (let ((out_0 (begin-unsafe (weak-box-value r_0)))) + (begin + (if out_0 (temp18.1$1 out_0) (void)) + (values + #f + (wrap-evt + (semaphore-peek-evt (pipe-data-read-ready-sema o_0)) + (lambda (v_0) 0)))))))))))))) (current-inspector) #f '(0) @@ -8882,272 +8800,243 @@ 'peek-via-read-input-port-methods 'read-in/inner)))))) (define peek-via-read-input-port-vtable.1 - (let ((app_0 (core-port-methods-count-lines!.1 commit-input-port-vtable.1))) - (let ((app_1 - (core-port-methods-get-location.1 commit-input-port-vtable.1))) - (peek-via-read-input-port-methods10.1 - (|#%name| - close - (lambda (this-id_0) (begin (|#%app| temp7.1 this-id_0)))) - app_0 - app_1 - (core-port-methods-file-position.1 commit-input-port-vtable.1) - (|#%name| - buffer-mode - (case-lambda - ((this-id_0) (begin (|#%app| temp9.1 this-id_0))) - ((this-id_0 mode42_0) (|#%app| temp9.1 this-id_0 mode42_0)))) - (|#%name| - prepare-change - (lambda (this-id_0) (begin (temp2.1 this-id_0)))) - (|#%name| - read-in - (lambda (this-id_0 dest-bstr131_0 start132_0 end133_0 copy?134_0) - (begin - (begin - (|#%app| temp5.1$1 this-id_0) - (letrec* - ((try-again_0 - (|#%name| - try-again - (lambda () - (begin - (if (let ((app_2 + (peek-via-read-input-port-methods10.1 + (|#%name| close (lambda (this-id_0) (begin (temp7.1 this-id_0)))) + (core-port-methods-count-lines!.1 commit-input-port-vtable.1) + (core-port-methods-get-location.1 commit-input-port-vtable.1) + (core-port-methods-file-position.1 commit-input-port-vtable.1) + (|#%name| + buffer-mode + (case-lambda + ((this-id_0) (begin (temp9.1 this-id_0))) + ((this-id_0 mode42_0) (temp9.1 this-id_0 mode42_0)))) + (|#%name| prepare-change (lambda (this-id_0) (begin (temp2.1 this-id_0)))) + (|#%name| + read-in + (lambda (this-id_0 dest-bstr131_0 start132_0 end133_0 copy?134_0) + (begin + (begin + (temp5.1$1 this-id_0) + (letrec* + ((try-again_0 + (|#%name| + try-again + (lambda () + (begin + (if (fx< + (peek-via-read-input-port-pos this-id_0) + (peek-via-read-input-port-end-pos this-id_0)) + (let ((amt_0 + (let ((app_0 + (fx- + (peek-via-read-input-port-end-pos this-id_0) + (peek-via-read-input-port-pos this-id_0)))) + (min app_0 (fx- end133_0 start132_0))))) + (begin + (let ((app_0 + (peek-via-read-input-port-bstr this-id_0))) + (let ((app_1 (peek-via-read-input-port-pos this-id_0))) - (fx< - app_2 - (peek-via-read-input-port-end-pos this-id_0))) - (let ((amt_0 - (let ((app_2 - (let ((app_2 - (peek-via-read-input-port-end-pos - this-id_0))) - (fx- - app_2 - (peek-via-read-input-port-pos - this-id_0))))) - (min app_2 (fx- end133_0 start132_0))))) - (begin - (let ((app_2 - (peek-via-read-input-port-bstr this-id_0))) - (let ((app_3 - (peek-via-read-input-port-pos this-id_0))) - (unsafe-bytes-copy! - dest-bstr131_0 - start132_0 - app_2 - app_3 - (fx+ - (peek-via-read-input-port-pos this-id_0) - amt_0)))) - (set-peek-via-read-input-port-pos! - this-id_0 + (unsafe-bytes-copy! + dest-bstr131_0 + start132_0 + app_0 + app_1 (fx+ (peek-via-read-input-port-pos this-id_0) - amt_0)) - (temp1.1 this-id_0) - (|#%app| temp4.1$1 this-id_0 amt_0) - amt_0)) - (if (peek-via-read-input-port-peeked-eof? this-id_0) + amt_0)))) + (set-peek-via-read-input-port-pos! + this-id_0 + (fx+ (peek-via-read-input-port-pos this-id_0) amt_0)) + (temp1.1 this-id_0) + (temp4.1$1 this-id_0 amt_0) + amt_0)) + (if (peek-via-read-input-port-peeked-eof? this-id_0) + (begin + (set-peek-via-read-input-port-peeked-eof?! + this-id_0 + #f) + eof) + (if (if (eq? + 'block + (peek-via-read-input-port-buffer-mode + this-id_0)) + (let ((app_0 (fx- end133_0 start132_0))) + (fx< + app_0 + (fxrshift + (unsafe-bytes-length + (peek-via-read-input-port-bstr this-id_0)) + 1))) + #f) + (let ((v_0 (temp1.1$1 this-id_0))) + (if (let ((or-part_0 (eqv? v_0 0))) + (if or-part_0 or-part_0 (evt? v_0))) + v_0 + (try-again_0))) + (let ((v_0 + (|#%app| + (peek-via-read-input-port-methods-read-in/inner.1 + (core-port-vtable this-id_0)) + this-id_0 + dest-bstr131_0 + start132_0 + end133_0 + copy?134_0))) (begin - (set-peek-via-read-input-port-peeked-eof?! - this-id_0 - #f) - eof) - (if (if (eq? - 'block - (peek-via-read-input-port-buffer-mode - this-id_0)) - (let ((app_2 (fx- end133_0 start132_0))) - (fx< - app_2 - (fxrshift - (unsafe-bytes-length - (peek-via-read-input-port-bstr this-id_0)) - 1))) - #f) - (let ((v_0 (|#%app| temp1.1$1 this-id_0))) - (if (let ((or-part_0 (eqv? v_0 0))) - (if or-part_0 or-part_0 (evt? v_0))) - v_0 - (try-again_0))) - (let ((v_0 - (|#%app| - (peek-via-read-input-port-methods-read-in/inner.1 - (core-port-vtable this-id_0)) - this-id_0 - dest-bstr131_0 - start132_0 - end133_0 - copy?134_0))) - (begin - (if (eqv? v_0 0) (void) (temp1.1 this-id_0)) - v_0)))))))))) - (try-again_0)))))) - (|#%name| - peek-in - (lambda (this-id_0 - dest-bstr168_0 - start169_0 - end170_0 - skip171_0 - progress-evt172_0 - copy?173_0) - (begin - (letrec* - ((try-again_0 - (|#%name| - try-again - (lambda () - (begin - (if (if progress-evt172_0 - (sync/timeout 0 progress-evt172_0) - #f) - #f - (let ((b_0 (core-port-buffer this-id_0))) - (let ((s_0 - (if (direct-bstr b_0) - (direct-pos b_0) - (peek-via-read-input-port-pos this-id_0)))) - (let ((peeked-amt_0 - (fx- - (peek-via-read-input-port-end-pos this-id_0) - s_0))) - (if (> peeked-amt_0 skip171_0) - (let ((amt_0 - (let ((app_2 - (fx- peeked-amt_0 skip171_0))) - (min app_2 (fx- end170_0 start169_0))))) - (let ((s-pos_0 (fx+ s_0 skip171_0))) - (begin - (let ((app_2 - (peek-via-read-input-port-bstr - this-id_0))) - (unsafe-bytes-copy! - dest-bstr168_0 - start169_0 - app_2 - s-pos_0 - (fx+ s-pos_0 amt_0))) - (if (commit-input-port-progress-sema - this-id_0) - (void) - (|#%app| temp4.1$1 this-id_0 0)) - amt_0))) - (if (peek-via-read-input-port-peeked-eof? - this-id_0) - eof - (begin - (|#%app| temp5.1$1 this-id_0) - (let ((v_0 - (let ((app_2 temp2.1$1)) - (|#%app| - app_2 - this-id_0 - (let ((app_3 - (- skip171_0 peeked-amt_0))) - (+ - app_3 - (fx- end170_0 start169_0))))))) - (if (|#%app| temp3.1$2 this-id_0 v_0) - (try-again_0) - v_0)))))))))))))) - (try-again_0))))) - (|#%name| - byte-ready - (lambda (this-id_0 work-done!209_0) - (begin - (letrec* - ((loop_0 - (|#%name| - loop - (lambda () - (begin - (let ((b_0 (core-port-buffer this-id_0))) + (if (eqv? v_0 0) (void) (temp1.1 this-id_0)) + v_0)))))))))) + (try-again_0)))))) + (|#%name| + peek-in + (lambda (this-id_0 + dest-bstr168_0 + start169_0 + end170_0 + skip171_0 + progress-evt172_0 + copy?173_0) + (begin + (letrec* + ((try-again_0 + (|#%name| + try-again + (lambda () + (begin + (if (if progress-evt172_0 + (sync/timeout 0 progress-evt172_0) + #f) + #f + (let ((b_0 (core-port-buffer this-id_0))) + (let ((s_0 + (if (direct-bstr b_0) + (direct-pos b_0) + (peek-via-read-input-port-pos this-id_0)))) (let ((peeked-amt_0 - (let ((app_2 - (peek-via-read-input-port-end-pos - this-id_0))) - (fx- - app_2 - (if (direct-bstr b_0) - (direct-pos b_0) - (peek-via-read-input-port-pos this-id_0)))))) - (if (fx> peeked-amt_0 0) - #t + (fx- + (peek-via-read-input-port-end-pos this-id_0) + s_0))) + (if (> peeked-amt_0 skip171_0) + (let ((amt_0 + (let ((app_0 (fx- peeked-amt_0 skip171_0))) + (min app_0 (fx- end170_0 start169_0))))) + (let ((s-pos_0 (fx+ s_0 skip171_0))) + (begin + (let ((app_0 + (peek-via-read-input-port-bstr + this-id_0))) + (unsafe-bytes-copy! + dest-bstr168_0 + start169_0 + app_0 + s-pos_0 + (fx+ s-pos_0 amt_0))) + (if (commit-input-port-progress-sema this-id_0) + (void) + (temp4.1$1 this-id_0 0)) + amt_0))) (if (peek-via-read-input-port-peeked-eof? this-id_0) - #t + eof (begin - (|#%app| temp5.1$1 this-id_0) - (let ((v_0 (|#%app| temp1.1$1 this-id_0))) - (begin - (|#%app| work-done!209_0) - (if (|#%app| temp3.1$2 this-id_0 v_0) - (loop_0) - (if (evt? v_0) - v_0 - (not (eqv? v_0 0)))))))))))))))) - (loop_0))))) - (|#%name| - get-progress-evt - (lambda (this-id_0) - (begin - (begin - (unsafe-start-atomic) - (begin0 - (begin (|#%app| temp5.1$1 this-id_0) (temp4.1 this-id_0)) - (unsafe-end-atomic)))))) - (|#%name| - commit - (lambda (this-id_0 amt269_0 progress-evt270_0 ext-evt271_0 finish272_0) - (begin - (begin - (|#%app| temp5.1$1 this-id_0) - (temp3.1 - this-id_0 - progress-evt270_0 - ext-evt271_0 - (lambda () - (let ((amt_0 - (fxmin - amt269_0 - (let ((app_2 - (peek-via-read-input-port-end-pos this-id_0))) + (temp5.1$1 this-id_0) + (let ((v_0 + (temp2.1$1 + this-id_0 + (let ((app_0 (- skip171_0 peeked-amt_0))) + (+ app_0 (fx- end170_0 start169_0)))))) + (if (temp3.1$2 this-id_0 v_0) + (try-again_0) + v_0)))))))))))))) + (try-again_0))))) + (|#%name| + byte-ready + (lambda (this-id_0 work-done!209_0) + (begin + (letrec* + ((loop_0 + (|#%name| + loop + (lambda () + (begin + (let ((b_0 (core-port-buffer this-id_0))) + (let ((app_0 (peek-via-read-input-port-end-pos this-id_0))) + (let ((peeked-amt_0 (fx- - app_2 - (peek-via-read-input-port-pos this-id_0)))))) - (if (fx= 0 amt_0) - (|#%app| finish272_0 #vu8()) - (let ((dest-bstr_0 (make-bytes amt_0))) - (begin - (let ((app_2 - (peek-via-read-input-port-bstr this-id_0))) - (let ((app_3 - (peek-via-read-input-port-pos this-id_0))) - (unsafe-bytes-copy! - dest-bstr_0 - 0 - app_2 - app_3 - (fx+ - (peek-via-read-input-port-pos this-id_0) - amt_0)))) - (set-peek-via-read-input-port-pos! - this-id_0 - (fx+ (peek-via-read-input-port-pos this-id_0) amt_0)) - (temp1.1 this-id_0) - (|#%app| finish272_0 dest-bstr_0))))))))))) - (|#%name| - read-in/inner - (lambda (this-id_0 dest-bstr306_0 start307_0 end308_0 copy?309_0) - (begin 0))))))) + app_0 + (if (direct-bstr b_0) + (direct-pos b_0) + (peek-via-read-input-port-pos this-id_0))))) + (if (fx> peeked-amt_0 0) + #t + (if (peek-via-read-input-port-peeked-eof? this-id_0) + #t + (begin + (temp5.1$1 this-id_0) + (let ((v_0 (temp1.1$1 this-id_0))) + (begin + (|#%app| work-done!209_0) + (if (temp3.1$2 this-id_0 v_0) + (loop_0) + (if (evt? v_0) + v_0 + (not (eqv? v_0 0))))))))))))))))) + (loop_0))))) + (|#%name| + get-progress-evt + (lambda (this-id_0) + (begin + (begin + (unsafe-start-atomic) + (begin0 + (begin (temp5.1$1 this-id_0) (temp4.1 this-id_0)) + (unsafe-end-atomic)))))) + (|#%name| + commit + (lambda (this-id_0 amt269_0 progress-evt270_0 ext-evt271_0 finish272_0) + (begin + (begin + (temp5.1$1 this-id_0) + (temp3.1 + this-id_0 + progress-evt270_0 + ext-evt271_0 + (lambda () + (let ((amt_0 + (fxmin + amt269_0 + (fx- + (peek-via-read-input-port-end-pos this-id_0) + (peek-via-read-input-port-pos this-id_0))))) + (if (fx= 0 amt_0) + (|#%app| finish272_0 #vu8()) + (let ((dest-bstr_0 (make-bytes amt_0))) + (begin + (let ((app_0 (peek-via-read-input-port-bstr this-id_0))) + (let ((app_1 (peek-via-read-input-port-pos this-id_0))) + (unsafe-bytes-copy! + dest-bstr_0 + 0 + app_0 + app_1 + (fx+ + (peek-via-read-input-port-pos this-id_0) + amt_0)))) + (set-peek-via-read-input-port-pos! + this-id_0 + (fx+ (peek-via-read-input-port-pos this-id_0) amt_0)) + (temp1.1 this-id_0) + (|#%app| finish272_0 dest-bstr_0))))))))))) + (|#%name| + read-in/inner + (lambda (this-id_0 dest-bstr306_0 start307_0 end308_0 copy?309_0) + (begin 0))))) (define temp6.1$1 (|#%name| purge-buffer (lambda (this-id_0) (begin (begin - (|#%app| temp5.1$1 this-id_0) + (temp5.1$1 this-id_0) (set-peek-via-read-input-port-pos! this-id_0 0) (set-peek-via-read-input-port-end-pos! this-id_0 0) (set-peek-via-read-input-port-peeked-eof?! this-id_0 #f)))))) @@ -9213,16 +9102,14 @@ (peek-via-read-input-port-bstr this-id498_0)))))) (let ((v_0 - (let ((app_0 - (peek-via-read-input-port-methods-read-in/inner.1 - (core-port-vtable this-id498_0)))) - (|#%app| - app_0 - this-id498_0 - (peek-via-read-input-port-bstr this-id498_0) - offset493_0 - get-end_0 - #f)))) + (|#%app| + (peek-via-read-input-port-methods-read-in/inner.1 + (core-port-vtable this-id498_0)) + this-id498_0 + (peek-via-read-input-port-bstr this-id498_0) + offset493_0 + get-end_0 + #f))) (if (eof-object? v_0) (begin (set-peek-via-read-input-port-peeked-eof?! @@ -9266,27 +9153,23 @@ pull-more-bytes (lambda (this-id_0 amt621_0) (begin - (if (let ((app_0 (peek-via-read-input-port-end-pos this-id_0))) - (fx< - app_0 - (unsafe-bytes-length (peek-via-read-input-port-bstr this-id_0)))) + (if (fx< + (peek-via-read-input-port-end-pos this-id_0) + (unsafe-bytes-length (peek-via-read-input-port-bstr this-id_0))) (let ((pull-amt_0 (if (eq? 'block (peek-via-read-input-port-buffer-mode this-id_0)) - (let ((app_0 - (unsafe-bytes-length - (peek-via-read-input-port-bstr this-id_0)))) - (fx- app_0 (peek-via-read-input-port-end-pos this-id_0))) + (fx- + (unsafe-bytes-length + (peek-via-read-input-port-bstr this-id_0)) + (peek-via-read-input-port-end-pos this-id_0)) amt621_0))) - (let ((app_0 temp1.1$1)) - (let ((app_1 (peek-via-read-input-port-end-pos this-id_0))) - (|#%app| - app_0 - this-id_0 - pull-amt_0 - app_1 - (peek-via-read-input-port-pos this-id_0))))) + (temp1.1$1 + this-id_0 + pull-amt_0 + (peek-via-read-input-port-end-pos this-id_0) + (peek-via-read-input-port-pos this-id_0))) (if (fx= (peek-via-read-input-port-pos this-id_0) 0) (let ((new-bstr_0 (make-bytes @@ -9295,34 +9178,29 @@ (unsafe-bytes-length (peek-via-read-input-port-bstr this-id_0)))))) (begin - (let ((app_0 (peek-via-read-input-port-bstr this-id_0))) - (unsafe-bytes-copy! - new-bstr_0 - 0 - app_0 - 0 - (peek-via-read-input-port-end-pos this-id_0))) + (unsafe-bytes-copy! + new-bstr_0 + 0 + (peek-via-read-input-port-bstr this-id_0) + 0 + (peek-via-read-input-port-end-pos this-id_0)) (set-peek-via-read-input-port-bstr! this-id_0 new-bstr_0) - (let ((app_0 temp1.1$1)) - (|#%app| - app_0 - this-id_0 - amt621_0 - (peek-via-read-input-port-end-pos this-id_0))))) + (temp1.1$1 + this-id_0 + amt621_0 + (peek-via-read-input-port-end-pos this-id_0)))) (begin - (let ((app_0 (peek-via-read-input-port-bstr this-id_0))) - (let ((app_1 (peek-via-read-input-port-bstr this-id_0))) - (let ((app_2 (peek-via-read-input-port-pos this-id_0))) - (unsafe-bytes-copy! - app_0 - 0 - app_1 - app_2 - (peek-via-read-input-port-end-pos this-id_0))))) + (unsafe-bytes-copy! + (peek-via-read-input-port-bstr this-id_0) + 0 + (peek-via-read-input-port-bstr this-id_0) + (peek-via-read-input-port-pos this-id_0) + (peek-via-read-input-port-end-pos this-id_0)) (set-peek-via-read-input-port-end-pos! this-id_0 - (let ((app_0 (peek-via-read-input-port-end-pos this-id_0))) - (fx- app_0 (peek-via-read-input-port-pos this-id_0)))) + (fx- + (peek-via-read-input-port-end-pos this-id_0) + (peek-via-read-input-port-pos this-id_0))) (set-peek-via-read-input-port-pos! this-id_0 0) (temp2.1$1 this-id_0 amt621_0)))))))) (define temp3.1$2 @@ -9660,127 +9538,87 @@ 'fd-input-port-methods 'raise-read-error)))))) (define fd-input-port-vtable.1 - (let ((app_0 - (core-port-methods-count-lines!.1 peek-via-read-input-port-vtable.1))) - (let ((app_1 - (core-port-methods-get-location.1 - peek-via-read-input-port-vtable.1))) - (let ((app_2 - (core-port-methods-buffer-mode.1 - peek-via-read-input-port-vtable.1))) - (let ((app_3 - (core-input-port-methods-prepare-change.1 - peek-via-read-input-port-vtable.1))) - (let ((app_4 - (core-input-port-methods-read-in.1 - peek-via-read-input-port-vtable.1))) - (let ((app_5 - (core-input-port-methods-peek-in.1 - peek-via-read-input-port-vtable.1))) - (let ((app_6 - (core-input-port-methods-byte-ready.1 - peek-via-read-input-port-vtable.1))) - (let ((app_7 - (core-input-port-methods-get-progress-evt.1 - peek-via-read-input-port-vtable.1))) - (fd-input-port-methods6.1 - (|#%name| - close - (lambda (this-id_0) - (begin - (begin - (|#%app| - (fd-input-port-methods-on-close.1 - (core-port-vtable this-id_0)) - this-id_0) - (let ((fd75_0 (fd-input-port-fd this-id_0))) - (let ((fd-refcount76_0 - (fd-input-port-fd-refcount this-id_0))) - (let ((fd75_1 fd75_0)) - (fd-close.1 #f fd75_1 fd-refcount76_0)))) - (|#%app| - 1/unsafe-custodian-unregister - this-id_0 - (fd-input-port-custodian-reference this-id_0)) - (temp7.1 this-id_0))))) - app_0 - app_1 - (|#%name| - file-position - (case-lambda - ((this-id_0) - (begin - (let ((pos_0 - (let ((app_8 get-file-position)) - (|#%app| - app_8 - (fd-input-port-fd this-id_0))))) - (if pos_0 (temp8.1 this-id_0 pos_0) #f)))) - ((this-id_0 pos77_0) - (begin - (temp6.1$1 this-id_0) - (let ((app_8 set-file-position)) - (|#%app| - app_8 - (fd-input-port-fd this-id_0) - pos77_0)))))) - app_2 - app_3 - app_4 - app_5 - app_6 - app_7 - (core-input-port-methods-commit.1 - peek-via-read-input-port-vtable.1) - (|#%name| - read-in/inner - (lambda (this-id_0 - dest-bstr133_0 - start134_0 - end135_0 - copy?136_0) - (begin - (let ((n_0 - (|#%app| - rktio_read_in - (unsafe-place-local-ref cell.1) - (fd-input-port-fd this-id_0) - dest-bstr133_0 - start134_0 - end135_0))) - (if (vector? n_0) - (begin - (unsafe-end-atomic) - (|#%app| - (fd-input-port-methods-raise-read-error.1 - (core-port-vtable this-id_0)) - this-id_0 - n_0)) - (if (eqv? n_0 -1) - eof - (if (eqv? n_0 0) - (let ((or-part_0 - (fd-semaphore-update! - (fd-input-port-fd this-id_0) - 'read))) - (if or-part_0 - or-part_0 - (let ((app_8 fd-evt44.1)) - (|#%app| - app_8 - (fd-input-port-fd this-id_0) - 1 - this-id_0)))) - n_0))))))) - (|#%name| on-close (lambda (this-id_0) (begin (void)))) - (|#%name| - raise-read-error - (lambda (this-id_0 n195_0) - (begin - (raise-filesystem-error - #f - n195_0 - "error reading from stream port")))))))))))))) + (fd-input-port-methods6.1 + (|#%name| + close + (lambda (this-id_0) + (begin + (begin + (|#%app| + (fd-input-port-methods-on-close.1 (core-port-vtable this-id_0)) + this-id_0) + (let ((fd75_0 (fd-input-port-fd this-id_0))) + (let ((fd-refcount76_0 (fd-input-port-fd-refcount this-id_0))) + (fd-close.1 #f fd75_0 fd-refcount76_0))) + (|#%app| + 1/unsafe-custodian-unregister + this-id_0 + (fd-input-port-custodian-reference this-id_0)) + (temp7.1 this-id_0))))) + (core-port-methods-count-lines!.1 peek-via-read-input-port-vtable.1) + (core-port-methods-get-location.1 peek-via-read-input-port-vtable.1) + (|#%name| + file-position + (case-lambda + ((this-id_0) + (begin + (let ((pos_0 + (let ((app_0 get-file-position)) + (|#%app| app_0 (fd-input-port-fd this-id_0))))) + (if pos_0 (temp8.1 this-id_0 pos_0) #f)))) + ((this-id_0 pos77_0) + (begin + (temp6.1$1 this-id_0) + (let ((app_0 set-file-position)) + (|#%app| app_0 (fd-input-port-fd this-id_0) pos77_0)))))) + (core-port-methods-buffer-mode.1 peek-via-read-input-port-vtable.1) + (core-input-port-methods-prepare-change.1 peek-via-read-input-port-vtable.1) + (core-input-port-methods-read-in.1 peek-via-read-input-port-vtable.1) + (core-input-port-methods-peek-in.1 peek-via-read-input-port-vtable.1) + (core-input-port-methods-byte-ready.1 peek-via-read-input-port-vtable.1) + (core-input-port-methods-get-progress-evt.1 + peek-via-read-input-port-vtable.1) + (core-input-port-methods-commit.1 peek-via-read-input-port-vtable.1) + (|#%name| + read-in/inner + (lambda (this-id_0 dest-bstr133_0 start134_0 end135_0 copy?136_0) + (begin + (let ((n_0 + (|#%app| + rktio_read_in + (unsafe-place-local-ref cell.1) + (fd-input-port-fd this-id_0) + dest-bstr133_0 + start134_0 + end135_0))) + (if (vector? n_0) + (begin + (unsafe-end-atomic) + (|#%app| + (fd-input-port-methods-raise-read-error.1 + (core-port-vtable this-id_0)) + this-id_0 + n_0)) + (if (eqv? n_0 -1) + eof + (if (eqv? n_0 0) + (let ((or-part_0 + (fd-semaphore-update! + (fd-input-port-fd this-id_0) + 'read))) + (if or-part_0 + or-part_0 + (fd-evt44.1 (fd-input-port-fd this-id_0) 1 this-id_0))) + n_0))))))) + (|#%name| on-close (lambda (this-id_0) (begin (void)))) + (|#%name| + raise-read-error + (lambda (this-id_0 n195_0) + (begin + (raise-filesystem-error + #f + n195_0 + "error reading from stream port")))))) (define open-input-fd.1 (|#%name| open-input-fd @@ -9794,28 +9632,29 @@ (if (eq? custodian8_0 unsafe-undefined) (current-custodian) custodian8_0))) - (let ((temp224_0 - (create-fd-input-port - fd-input-port-vtable.1 - name12_0 - (direct2.1 #f 0 0) - #f - #f - 0 - #f - #f - #f - #f - #f - (make-bytes 4096) - 0 - 0 - #f - 'block - fd11_0 - fd-refcount_0 - #f))) - (finish-fd-input-port.1 cust_0 temp224_0)))))))) + (let ((app_0 (direct2.1 #f 0 0))) + (let ((temp224_0 + (create-fd-input-port + fd-input-port-vtable.1 + name12_0 + app_0 + #f + #f + 0 + #f + #f + #f + #f + #f + (make-bytes 4096) + 0 + 0 + #f + 'block + fd11_0 + fd-refcount_0 + #f))) + (finish-fd-input-port.1 cust_0 temp224_0))))))))) (define finish-fd-input-port.1 (|#%name| finish-fd-input-port @@ -10058,8 +9897,7 @@ (let ((fd255_0 (fd-output-port-fd this-id_0))) (let ((fd-refcount256_0 (fd-output-port-fd-refcount this-id_0))) - (let ((fd255_1 fd255_0)) - (fd-close.1 #f fd255_1 fd-refcount256_0)))) + (fd-close.1 #f fd255_0 fd-refcount256_0))) (|#%app| 1/unsafe-custodian-unregister this-id_0 @@ -10123,23 +9961,20 @@ (fd-output-port-buffer-mode this-id_0) 'none)) (if (not nonbuffer/nonblock?372_0) - (let ((app_4 (fd-output-port-end-pos this-id_0))) - (fx< - app_4 - (unsafe-bytes-length - (fd-output-port-bstr this-id_0)))) + (fx< + (fd-output-port-end-pos this-id_0) + (unsafe-bytes-length + (fd-output-port-bstr this-id_0))) #f) #f) (let ((amt_0 (let ((app_4 (fx- src-end371_0 src-start370_0))) (fxmin app_4 - (let ((app_5 - (unsafe-bytes-length - (fd-output-port-bstr this-id_0)))) - (fx- - app_5 - (fd-output-port-end-pos this-id_0))))))) + (fx- + (unsafe-bytes-length + (fd-output-port-bstr this-id_0)) + (fd-output-port-end-pos this-id_0)))))) (begin (let ((app_4 (fd-output-port-bstr this-id_0))) (let ((app_5 (fd-output-port-end-pos this-id_0))) @@ -10269,19 +10104,17 @@ (begin (temp23.1 this-id_0) (if (not - (let ((app_0 (fd-output-port-start-pos this-id_0))) - (fx= app_0 (fd-output-port-end-pos this-id_0)))) + (fx= + (fd-output-port-start-pos this-id_0) + (fd-output-port-end-pos this-id_0))) (let ((n_0 - (let ((app_0 (fd-output-port-fd this-id_0))) - (let ((app_1 (fd-output-port-bstr this-id_0))) - (let ((app_2 (fd-output-port-start-pos this-id_0))) - (|#%app| - rktio_write_in - (unsafe-place-local-ref cell.1) - app_0 - app_1 - app_2 - (fd-output-port-end-pos this-id_0))))))) + (|#%app| + rktio_write_in + (unsafe-place-local-ref cell.1) + (fd-output-port-fd this-id_0) + (fd-output-port-bstr this-id_0) + (fd-output-port-start-pos this-id_0) + (fd-output-port-end-pos this-id_0)))) (if (vector? n_0) (begin (set-fd-output-port-start-pos! this-id_0 0) @@ -10410,36 +10243,37 @@ (if (eq? custodian30_0 unsafe-undefined) (current-custodian) custodian30_0))) - (let ((temp692_0 - (let ((app_0 (make-bytes 4096))) - (create-fd-output-port - fd-output-port-vtable.1 - name36_0 - (direct2.1 #f 0 0) - #f - #f - 0 - #f - always-evt - #f - #f - #f - fd35_0 - fd-refcount_0 - app_0 - 0 - 0 - #f - (if (eq? buffer-mode27_0 'infer) - (if (|#%app| - rktio_fd_is_terminal - (unsafe-place-local-ref cell.1) - fd35_0) - 'line - 'block) - buffer-mode27_0) - #f)))) - (finish-fd-output-port.1 cust_0 plumber_0 temp692_0))))))))) + (let ((app_0 (direct2.1 #f 0 0))) + (let ((temp692_0 + (let ((app_1 (make-bytes 4096))) + (create-fd-output-port + fd-output-port-vtable.1 + name36_0 + app_0 + #f + #f + 0 + #f + always-evt + #f + #f + #f + fd35_0 + fd-refcount_0 + app_1 + 0 + 0 + #f + (if (eq? buffer-mode27_0 'infer) + (if (|#%app| + rktio_fd_is_terminal + (unsafe-place-local-ref cell.1) + fd35_0) + 'line + 'block) + buffer-mode27_0) + #f)))) + (finish-fd-output-port.1 cust_0 plumber_0 temp692_0)))))))))) (define finish-fd-output-port.1 (|#%name| finish-fd-output-port @@ -10455,7 +10289,7 @@ custodian39_0))) (let ((fd_0 (fd-output-port-fd p42_0))) (let ((fd-refcount_0 (fd-output-port-fd-refcount p42_0))) - (let ((evt_0 (|#%app| fd-evt44.1 fd_0 2 p42_0))) + (let ((evt_0 (fd-evt44.1 fd_0 2 p42_0))) (let ((flush-handle_0 (if plumber_0 (plumber-add-flush! @@ -11152,14 +10986,16 @@ (result-loop_0 v_0))) (begin (unsafe-end-atomic) - (loop_0 - (->core-input-port.1 - unsafe-undefined - read-in_0 - #f) - (cons - in_0 - extra-count-ins_0)))))))))))))))))) + (let ((app_0 + (->core-input-port.1 + unsafe-undefined + read-in_0 + #f))) + (loop_0 + app_0 + (cons + in_0 + extra-count-ins_0))))))))))))))))))) (loop_0 orig-in14_0 null)))))) (define peek-some-bytes!.1 (|#%name| @@ -11401,63 +11237,66 @@ (let ((buffer_0 (core-port-buffer in_0))) (let ((bstr_0 (direct-bstr buffer_0))) (let ((pos_0 (direct-pos buffer_0))) - (let ((end_0 - (let ((app_0 (direct-end buffer_0))) - (fxmin app_0 (fx+ pos_0 4096))))) - (let ((finish_0 - (|#%name| - finish - (lambda (end_1 read-end_0) - (begin + (let ((app_0 (direct-end buffer_0))) + (let ((end_0 (fxmin app_0 (fx+ pos_0 4096)))) + (let ((finish_0 + (|#%name| + finish + (lambda (end_1 read-end_0) (begin - (set-direct-pos! buffer_0 read-end_0) (begin - (if (core-port-count in_0) - (port-count! - in_0 - (fx- read-end_0 pos_0) - bstr_0 - pos_0) - (void)) - (let ((result_0 - (if as-string?_0 - (a-bytes->string/utf-8.1 - #f - bstr_0 - pos_0 - end_1 - '#\xfffd) - (subbytes bstr_0 pos_0 end_1)))) - (begin (unsafe-end-atomic) result_0))))))))) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (i_0) - (begin - (if (fx= i_0 end_0) - (begin (unsafe-end-atomic) #f) - (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) - (if (if lf?_0 (eqv? b_0 10) #f) - (finish_0 i_0 (fx+ i_0 1)) - (if (if (if cr?_0 cr?_0 crlf?_0) - (eqv? b_0 13) - #f) - (if (if crlf?_0 - (if (fx< (fx+ i_0 1) end_0) - (eqv? - (unsafe-bytes-ref bstr_0 (fx+ i_0 1)) - 10) - #f) + (set-direct-pos! buffer_0 read-end_0) + (begin + (if (core-port-count in_0) + (port-count! + in_0 + (fx- read-end_0 pos_0) + bstr_0 + pos_0) + (void)) + (let ((result_0 + (if as-string?_0 + (a-bytes->string/utf-8.1 + #f + bstr_0 + pos_0 + end_1 + '#\xfffd) + (subbytes bstr_0 pos_0 end_1)))) + (begin (unsafe-end-atomic) result_0))))))))) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (i_0) + (begin + (if (fx= i_0 end_0) + (begin (unsafe-end-atomic) #f) + (let ((b_0 (unsafe-bytes-ref bstr_0 i_0))) + (if (if lf?_0 (eqv? b_0 10) #f) + (finish_0 i_0 (fx+ i_0 1)) + (if (if (if cr?_0 cr?_0 crlf?_0) + (eqv? b_0 13) #f) - (finish_0 i_0 (fx+ i_0 2)) - (if cr?_0 - (if (if crlf?_0 (fx= (fx+ i_0 1) end_0) #f) - (begin (unsafe-end-atomic) #f) - (finish_0 i_0 (fx+ i_0 1))) - (loop_0 (fx+ i_0 1)))) - (loop_0 (fx+ i_0 1))))))))))) - (loop_0 pos_0)))))))))) + (if (if crlf?_0 + (if (fx< (fx+ i_0 1) end_0) + (eqv? + (unsafe-bytes-ref + bstr_0 + (fx+ i_0 1)) + 10) + #f) + #f) + (finish_0 i_0 (fx+ i_0 2)) + (if cr?_0 + (if (if crlf?_0 + (fx= (fx+ i_0 1) end_0) + #f) + (begin (unsafe-end-atomic) #f) + (finish_0 i_0 (fx+ i_0 1))) + (loop_0 (fx+ i_0 1)))) + (loop_0 (fx+ i_0 1))))))))))) + (loop_0 pos_0))))))))))) (define struct:progress-evt (make-record-type-descriptor* 'progress-evt #f #f #f #f 2 0)) (define effect_2813 @@ -11625,21 +11464,19 @@ (begin (unsafe-start-atomic) (begin0 - (let ((app_0 - (core-input-port-methods-commit.1 - (core-port-vtable in_1)))) - (|#%app| - app_0 - in_1 - amt4_0 - (progress-evt-evt progress-evt5_0) - evt6_0 - (lambda (bstr_0) - (port-count! - in_1 - (unsafe-bytes-length bstr_0) - bstr_0 - 0)))) + (|#%app| + (core-input-port-methods-commit.1 + (core-port-vtable in_1)) + in_1 + amt4_0 + (progress-evt-evt progress-evt5_0) + evt6_0 + (lambda (bstr_0) + (port-count! + in_1 + (unsafe-bytes-length bstr_0) + bstr_0 + 0))) (unsafe-end-atomic))))))))))) (|#%name| port-commit-peeked @@ -13635,14 +13472,16 @@ (result-loop_0 v_0))) (begin (unsafe-end-atomic) - (try-again_0 - (->core-output-port.1 - unsafe-undefined - write-out_0 - #f) - (cons - out_0 - extra-count-outs_0))))))))))))))))) + (let ((app_0 + (->core-output-port.1 + unsafe-undefined + write-out_0 + #f))) + (try-again_0 + app_0 + (cons + out_0 + extra-count-outs_0)))))))))))))))))) (try-again_0 out10_0 null)))))) (define 1/write-byte (let ((write-byte_0 @@ -16936,7 +16775,7 @@ ((in-bstr_0 err-char5_0) (bytes->string/locale_0 in-bstr_0 err-char5_0 0 unsafe-undefined)))))) (define struct:path (make-record-type-descriptor* 'path #f #f #f #f 2 0)) -(define effect_2481 +(define effect_2266 (struct-type-install-properties! struct:path 'path @@ -16949,8 +16788,7 @@ prop:equal+hash (list (lambda (p1_0 p2_0 eql?_0) - (let ((app_0 (path-bytes p1_0))) - (|#%app| eql?_0 app_0 (path-bytes p2_0)))) + (|#%app| eql?_0 (path-bytes p1_0) (path-bytes p2_0))) (lambda (p_0 hc_0) (|#%app| hc_0 (path-bytes p_0))) (lambda (p_0 hc_0) (|#%app| hc_0 (path-bytes p_0))))) (cons @@ -18323,165 +18161,156 @@ (bytes-input-port-methods?.1_2316 (impersonator-val v)) #f)))))) (define bytes-input-port-vtable.1 - (let ((app_0 (core-port-methods-count-lines!.1 commit-input-port-vtable.1))) - (let ((app_1 - (core-port-methods-get-location.1 commit-input-port-vtable.1))) - (bytes-input-port-methods4.1 - (|#%name| - close - (lambda (this-id_0) + (bytes-input-port-methods4.1 + (|#%name| + close + (lambda (this-id_0) + (begin + (begin + (set-commit-input-port-commit-manager! this-id_0 #f) (begin + (temp1.1 this-id_0) (begin - (set-commit-input-port-commit-manager! this-id_0 #f) - (begin - (temp1.1 this-id_0) - (begin - (set-bytes-input-port-bstr! this-id_0 #f) - (let ((b_0 (core-port-buffer this-id_0))) - (if (direct-bstr b_0) - (begin - (set-core-port-offset! this-id_0 (direct-pos b_0)) - (set-direct-bstr! b_0 #f)) - (void))))))))) - app_0 - app_1 - (|#%name| - file-position - (case-lambda - ((this-id_0) - (begin - (let ((or-part_0 (bytes-input-port-alt-pos this-id_0))) - (if or-part_0 or-part_0 (|#%app| temp3.1$1 this-id_0))))) - ((this-id_0 given-pos36_0) - (let ((b_0 (core-port-buffer this-id_0))) - (let ((len_0 (direct-end b_0))) - (let ((new-pos_0 - (if (eof-object? given-pos36_0) - len_0 - (min len_0 given-pos36_0)))) - (begin - (if (direct-bstr b_0) - (set-direct-pos! b_0 new-pos_0) - (set-bytes-input-port-pos! this-id_0 new-pos_0)) - (set-bytes-input-port-alt-pos! - this-id_0 - (if (not (eof-object? given-pos36_0)) - (if (> given-pos36_0 new-pos_0) given-pos36_0 #f) - #f))))))))) - (core-port-methods-buffer-mode.1 commit-input-port-vtable.1) - (|#%name| - prepare-change - (lambda (this-id_0) (begin (temp2.1 this-id_0)))) - (|#%name| - read-in - (lambda (this-id_0 dest-bstr95_0 start96_0 end97_0 copy?98_0) - (begin - (let ((b_0 (core-port-buffer this-id_0))) - (let ((len_0 (direct-end b_0))) - (let ((i_0 (|#%app| temp3.1$1 this-id_0))) - (if (< i_0 len_0) + (set-bytes-input-port-bstr! this-id_0 #f) + (let ((b_0 (core-port-buffer this-id_0))) + (if (direct-bstr b_0) + (begin + (set-core-port-offset! this-id_0 (direct-pos b_0)) + (set-direct-bstr! b_0 #f)) + (void))))))))) + (core-port-methods-count-lines!.1 commit-input-port-vtable.1) + (core-port-methods-get-location.1 commit-input-port-vtable.1) + (|#%name| + file-position + (case-lambda + ((this-id_0) + (begin + (let ((or-part_0 (bytes-input-port-alt-pos this-id_0))) + (if or-part_0 or-part_0 (temp3.1$1 this-id_0))))) + ((this-id_0 given-pos36_0) + (let ((b_0 (core-port-buffer this-id_0))) + (let ((len_0 (direct-end b_0))) + (let ((new-pos_0 + (if (eof-object? given-pos36_0) + len_0 + (min len_0 given-pos36_0)))) + (begin + (if (direct-bstr b_0) + (set-direct-pos! b_0 new-pos_0) + (set-bytes-input-port-pos! this-id_0 new-pos_0)) + (set-bytes-input-port-alt-pos! + this-id_0 + (if (not (eof-object? given-pos36_0)) + (if (> given-pos36_0 new-pos_0) given-pos36_0 #f) + #f))))))))) + (core-port-methods-buffer-mode.1 commit-input-port-vtable.1) + (|#%name| prepare-change (lambda (this-id_0) (begin (temp2.1 this-id_0)))) + (|#%name| + read-in + (lambda (this-id_0 dest-bstr95_0 start96_0 end97_0 copy?98_0) + (begin + (let ((b_0 (core-port-buffer this-id_0))) + (let ((len_0 (direct-end b_0))) + (let ((i_0 (temp3.1$1 this-id_0))) + (if (< i_0 len_0) + (let ((amt_0 + (let ((app_0 (- end97_0 start96_0))) + (min app_0 (fx- len_0 i_0))))) + (let ((new-pos_0 (fx+ i_0 amt_0))) + (begin + (set-direct-pos! b_0 new-pos_0) + (set-core-port-offset! this-id_0 0) + (set-direct-bstr! b_0 (bytes-input-port-bstr this-id_0)) + (unsafe-bytes-copy! + dest-bstr95_0 + start96_0 + (bytes-input-port-bstr this-id_0) + i_0 + new-pos_0) + (temp1.1 this-id_0) + amt_0))) + eof))))))) + (|#%name| + peek-in + (lambda (this-id_0 + dest-bstr122_0 + start123_0 + end124_0 + skip125_0 + progress-evt126_0 + copy?127_0) + (begin + (let ((b_0 (core-port-buffer this-id_0))) + (let ((len_0 (direct-end b_0))) + (let ((i_0 (temp3.1$1 this-id_0))) + (let ((at-pos_0 (+ i_0 skip125_0))) + (if (if progress-evt126_0 + (sync/timeout 0 progress-evt126_0) + #f) + #f + (if (< at-pos_0 len_0) (let ((amt_0 - (let ((app_2 (- end97_0 start96_0))) - (min app_2 (fx- len_0 i_0))))) - (let ((new-pos_0 (fx+ i_0 amt_0))) - (begin - (set-direct-pos! b_0 new-pos_0) - (set-core-port-offset! this-id_0 0) - (set-direct-bstr! - b_0 - (bytes-input-port-bstr this-id_0)) + (let ((app_0 (- end124_0 start123_0))) + (min app_0 (fx- len_0 at-pos_0))))) + (begin + (let ((app_0 (bytes-input-port-bstr this-id_0))) (unsafe-bytes-copy! - dest-bstr95_0 - start96_0 - (bytes-input-port-bstr this-id_0) - i_0 - new-pos_0) - (temp1.1 this-id_0) - amt_0))) - eof))))))) - (|#%name| - peek-in - (lambda (this-id_0 - dest-bstr122_0 - start123_0 - end124_0 - skip125_0 - progress-evt126_0 - copy?127_0) - (begin - (let ((b_0 (core-port-buffer this-id_0))) - (let ((len_0 (direct-end b_0))) - (let ((i_0 (|#%app| temp3.1$1 this-id_0))) - (let ((at-pos_0 (+ i_0 skip125_0))) - (if (if progress-evt126_0 - (sync/timeout 0 progress-evt126_0) - #f) - #f - (if (< at-pos_0 len_0) - (let ((amt_0 - (let ((app_2 (- end124_0 start123_0))) - (min app_2 (fx- len_0 at-pos_0))))) - (begin - (let ((app_2 (bytes-input-port-bstr this-id_0))) - (unsafe-bytes-copy! - dest-bstr122_0 - start123_0 - app_2 - at-pos_0 - (fx+ at-pos_0 amt_0))) - amt_0)) - eof))))))))) - (|#%name| byte-ready (lambda (this-id_0 work-done!153_0) (begin #t))) - (|#%name| - get-progress-evt - (lambda (this-id_0) - (begin + dest-bstr122_0 + start123_0 + app_0 + at-pos_0 + (fx+ at-pos_0 amt_0))) + amt_0)) + eof))))))))) + (|#%name| byte-ready (lambda (this-id_0 work-done!153_0) (begin #t))) + (|#%name| + get-progress-evt + (lambda (this-id_0) + (begin + (begin + (unsafe-start-atomic) + (begin0 (begin - (unsafe-start-atomic) - (begin0 - (begin - (if (commit-input-port-progress-sema this-id_0) - (void) - (let ((b_0 (core-port-buffer this-id_0))) - (if (direct-bstr b_0) - (let ((i_0 (direct-pos b_0))) - (begin - (set-bytes-input-port-pos! this-id_0 i_0) - (set-core-port-offset! this-id_0 i_0) - (set-direct-bstr! b_0 #f) - (set-direct-pos! b_0 (direct-end b_0)))) - (void)))) - (temp4.1 this-id_0)) - (unsafe-end-atomic)))))) - (|#%name| - commit - (lambda (this-id_0 amt193_0 progress-evt194_0 ext-evt195_0 finish196_0) - (begin - (temp3.1 - this-id_0 - progress-evt194_0 - ext-evt195_0 - (lambda () - (let ((b_0 (core-port-buffer this-id_0))) - (let ((len_0 (direct-end b_0))) - (let ((i_0 (|#%app| temp3.1$1 this-id_0))) - (let ((amt_0 (min amt193_0 (- len_0 i_0)))) - (let ((dest-bstr_0 (make-bytes amt_0))) - (begin - (let ((app_2 (bytes-input-port-bstr this-id_0))) - (unsafe-bytes-copy! - dest-bstr_0 - 0 - app_2 - i_0 - (+ i_0 amt_0))) - (set-direct-pos! b_0 (fx+ i_0 amt_0)) - (set-direct-bstr! - b_0 - (bytes-input-port-bstr this-id_0)) - (set-core-port-offset! this-id_0 0) - (temp1.1 this-id_0) - (|#%app| finish196_0 dest-bstr_0)))))))))))))))) + (if (commit-input-port-progress-sema this-id_0) + (void) + (let ((b_0 (core-port-buffer this-id_0))) + (if (direct-bstr b_0) + (let ((i_0 (direct-pos b_0))) + (begin + (set-bytes-input-port-pos! this-id_0 i_0) + (set-core-port-offset! this-id_0 i_0) + (set-direct-bstr! b_0 #f) + (set-direct-pos! b_0 (direct-end b_0)))) + (void)))) + (temp4.1 this-id_0)) + (unsafe-end-atomic)))))) + (|#%name| + commit + (lambda (this-id_0 amt193_0 progress-evt194_0 ext-evt195_0 finish196_0) + (begin + (temp3.1 + this-id_0 + progress-evt194_0 + ext-evt195_0 + (lambda () + (let ((b_0 (core-port-buffer this-id_0))) + (let ((len_0 (direct-end b_0))) + (let ((i_0 (temp3.1$1 this-id_0))) + (let ((amt_0 (min amt193_0 (- len_0 i_0)))) + (let ((dest-bstr_0 (make-bytes amt_0))) + (begin + (let ((app_0 (bytes-input-port-bstr this-id_0))) + (unsafe-bytes-copy! + dest-bstr_0 + 0 + app_0 + i_0 + (+ i_0 amt_0))) + (set-direct-pos! b_0 (fx+ i_0 amt_0)) + (set-direct-bstr! b_0 (bytes-input-port-bstr this-id_0)) + (set-core-port-offset! this-id_0 0) + (temp1.1 this-id_0) + (|#%app| finish196_0 dest-bstr_0)))))))))))))) (define temp3.1$1 (|#%name| in-buffer-pos @@ -18740,10 +18569,9 @@ (set-bytes-output-port-pos! this-id_0 end-i_0) (set-bytes-output-port-max-pos! this-id_0 - (let ((app_6 (bytes-output-port-pos this-id_0))) - (fxmax - app_6 - (bytes-output-port-max-pos this-id_0)))) + (fxmax + (bytes-output-port-pos this-id_0) + (bytes-output-port-max-pos this-id_0))) (|#%app| temp7.1$1 this-id_0) amt_0)))))))) app_4 @@ -18789,13 +18617,12 @@ (begin (let ((new-bstr_0 (make-bytes (fx* 2 len346_0)))) (begin - (let ((app_0 (bytes-output-port-bstr this-id_0))) - (unsafe-bytes-copy! - new-bstr_0 - 0 - app_0 - 0 - (bytes-output-port-pos this-id_0))) + (unsafe-bytes-copy! + new-bstr_0 + 0 + (bytes-output-port-bstr this-id_0) + 0 + (bytes-output-port-pos this-id_0)) (set-bytes-output-port-bstr! this-id_0 new-bstr_0))))))) (define temp6.1 (|#%name| @@ -18834,21 +18661,22 @@ (lambda (name9_0) (begin (finish-port/count - (create-bytes-output-port - bytes-output-port-vtable.1 - name9_0 - (direct2.1 #f 0 0) - #f - #f - 0 - #f - always-evt - #f - #f - #f - (make-bytes 16) - 0 - 0))))))) + (let ((app_0 (direct2.1 #f 0 0))) + (create-bytes-output-port + bytes-output-port-vtable.1 + name9_0 + app_0 + #f + #f + 0 + #f + always-evt + #f + #f + #f + (make-bytes 16) + 0 + 0)))))))) (|#%name| open-output-bytes (case-lambda @@ -19100,121 +18928,100 @@ (max-output-port-methods?.1_2811 (impersonator-val v)) #f)))))) (define max-output-port-vtable.1 - (let ((app_0 (core-port-methods-close.1 core-output-port-vtable.1))) - (let ((app_1 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) - (let ((app_2 - (core-port-methods-get-location.1 core-output-port-vtable.1))) - (let ((app_3 - (core-port-methods-file-position.1 core-output-port-vtable.1))) - (let ((app_4 - (core-port-methods-buffer-mode.1 core-output-port-vtable.1))) - (let ((app_5 - (core-output-port-methods-write-out-special.1 - core-output-port-vtable.1))) - (let ((app_6 - (core-output-port-methods-get-write-evt.1 - core-output-port-vtable.1))) - (max-output-port-methods1.1 - app_0 - app_1 - app_2 - app_3 - app_4 - (|#%name| - write-out - (lambda (this-id_0 - src-bstr4_0 - src-start5_0 - src-end6_0 - nonblock?7_0 - enable-break?8_0 - copy?9_0) - (begin - (if (max-output-port-max-length this-id_0) - (let ((len_0 (- src-end6_0 src-start5_0))) - (if (eq? - (max-output-port-max-length this-id_0) - 'full) - len_0 - (if (pair? (max-output-port-max-length this-id_0)) - (begin - (set-max-output-port-max-length! - this-id_0 - (more-pending - (max-output-port-max-length this-id_0) - src-start5_0 - src-end6_0 - src-bstr4_0)) - len_0) - (let ((write-len_0 - (min - len_0 - (max-output-port-max-length this-id_0)))) - (begin - (unsafe-end-atomic) - (let ((wrote-len_0 - (let ((app_7 - (max-output-port-o this-id_0))) - (1/write-bytes - src-bstr4_0 - app_7 - src-start5_0 - (+ src-start5_0 write-len_0))))) - (begin - (unsafe-start-atomic) - (if (= - (max-output-port-max-length - this-id_0) - wrote-len_0) - (begin - (set-max-output-port-max-length! - this-id_0 - (more-pending - '(0 . #vu8()) - (+ - src-start5_0 - (max-output-port-max-length - this-id_0)) - src-end6_0 - src-bstr4_0)) - len_0) - (begin - (set-max-output-port-max-length! - this-id_0 - (- - (max-output-port-max-length - this-id_0) - wrote-len_0)) - wrote-len_0))))))))) + (max-output-port-methods1.1 + (core-port-methods-close.1 core-output-port-vtable.1) + (core-port-methods-count-lines!.1 core-output-port-vtable.1) + (core-port-methods-get-location.1 core-output-port-vtable.1) + (core-port-methods-file-position.1 core-output-port-vtable.1) + (core-port-methods-buffer-mode.1 core-output-port-vtable.1) + (|#%name| + write-out + (lambda (this-id_0 + src-bstr4_0 + src-start5_0 + src-end6_0 + nonblock?7_0 + enable-break?8_0 + copy?9_0) + (begin + (if (max-output-port-max-length this-id_0) + (let ((len_0 (- src-end6_0 src-start5_0))) + (if (eq? (max-output-port-max-length this-id_0) 'full) + len_0 + (if (pair? (max-output-port-max-length this-id_0)) + (begin + (set-max-output-port-max-length! + this-id_0 + (more-pending + (max-output-port-max-length this-id_0) + src-start5_0 + src-end6_0 + src-bstr4_0)) + len_0) + (let ((write-len_0 + (min len_0 (max-output-port-max-length this-id_0)))) + (begin + (unsafe-end-atomic) + (let ((app_0 (max-output-port-o this-id_0))) + (let ((wrote-len_0 + (1/write-bytes + src-bstr4_0 + app_0 + src-start5_0 + (+ src-start5_0 write-len_0)))) (begin - (unsafe-end-atomic) - (let ((len_0 - (1/write-bytes - src-bstr4_0 - (max-output-port-o this-id_0) - src-start5_0 - src-end6_0))) - (begin (unsafe-start-atomic) len_0))))))) - app_5 - app_6 - (core-output-port-methods-get-write-special-evt.1 - core-output-port-vtable.1)))))))))) + (unsafe-start-atomic) + (if (= + (max-output-port-max-length this-id_0) + wrote-len_0) + (begin + (set-max-output-port-max-length! + this-id_0 + (more-pending + '(0 . #vu8()) + (+ + src-start5_0 + (max-output-port-max-length this-id_0)) + src-end6_0 + src-bstr4_0)) + len_0) + (begin + (set-max-output-port-max-length! + this-id_0 + (- + (max-output-port-max-length this-id_0) + wrote-len_0)) + wrote-len_0)))))))))) + (begin + (unsafe-end-atomic) + (let ((len_0 + (1/write-bytes + src-bstr4_0 + (max-output-port-o this-id_0) + src-start5_0 + src-end6_0))) + (begin (unsafe-start-atomic) len_0))))))) + (core-output-port-methods-write-out-special.1 core-output-port-vtable.1) + (core-output-port-methods-get-write-evt.1 core-output-port-vtable.1) + (core-output-port-methods-get-write-special-evt.1 + core-output-port-vtable.1))) (define make-max-output-port (lambda (o_0 max-length_0) - (create-max-output-port - max-output-port-vtable.1 - (object-name o_0) - (direct2.1 #f 0 0) - #f - #f - 0 - #f - o_0 - #f - #f - #f - o_0 - max-length_0))) + (let ((app_0 (object-name o_0))) + (create-max-output-port + max-output-port-vtable.1 + app_0 + (direct2.1 #f 0 0) + #f + #f + 0 + #f + o_0 + #f + #f + #f + o_0 + max-length_0)))) (define write-string/max (let ((write-string/max_0 (|#%name| @@ -20052,37 +19859,20 @@ (nowhere-output-port-methods?.1_2940 (impersonator-val v)) #f)))))) (define nowhere-output-port-vtable.1 - (let ((app_0 (core-port-methods-close.1 core-output-port-vtable.1))) - (let ((app_1 (core-port-methods-count-lines!.1 core-output-port-vtable.1))) - (let ((app_2 - (core-port-methods-get-location.1 core-output-port-vtable.1))) - (let ((app_3 - (core-port-methods-file-position.1 core-output-port-vtable.1))) - (let ((app_4 - (core-port-methods-buffer-mode.1 core-output-port-vtable.1))) - (let ((app_5 - (core-output-port-methods-write-out.1 - core-output-port-vtable.1))) - (let ((app_6 - (core-output-port-methods-get-write-evt.1 - core-output-port-vtable.1))) - (nowhere-output-port-methods1.1 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - (|#%name| - write-out-special - (lambda (this-id_0 - any4_0 - no-block/buffer?5_0 - enable-break?6_0) - (begin #t))) - app_6 - (core-output-port-methods-get-write-special-evt.1 - core-output-port-vtable.1)))))))))) + (nowhere-output-port-methods1.1 + (core-port-methods-close.1 core-output-port-vtable.1) + (core-port-methods-count-lines!.1 core-output-port-vtable.1) + (core-port-methods-get-location.1 core-output-port-vtable.1) + (core-port-methods-file-position.1 core-output-port-vtable.1) + (core-port-methods-buffer-mode.1 core-output-port-vtable.1) + (core-output-port-methods-write-out.1 core-output-port-vtable.1) + (|#%name| + write-out-special + (lambda (this-id_0 any4_0 no-block/buffer?5_0 enable-break?6_0) + (begin #t))) + (core-output-port-methods-get-write-evt.1 core-output-port-vtable.1) + (core-output-port-methods-get-write-special-evt.1 + core-output-port-vtable.1))) (define open-output-nowhere (lambda () (finish-port/count @@ -21069,7 +20859,8 @@ (let ((val_0 (|#%app| v-ref_0 v_1 i_0))) (if (zero? i_0) (cons val_0 accum_0) - (loop_0 (sub1 i_0) (cons val_0 accum_0))))))))) + (let ((app_0 (sub1 i_0))) + (loop_0 app_0 (cons val_0 accum_0)))))))))) (loop_0 (sub1 len_0) '())))))))) (let ((cns_0 (string-append "(" fx/l-prefix_0 "vector"))) (if (if (not (eq? mode_0 0)) @@ -22980,11 +22771,10 @@ prev_0 (sub1 (unsafe-bytes-length prev_0))) 'unix) - (loop_0 (cons bstr_0 accum_0) (cdr subs_1) #f) - (loop_0 - (list* bstr_0 #vu8(47) accum_0) - (cdr subs_1) - #f)))) + (let ((app_0 (cons bstr_0 accum_0))) + (loop_0 app_0 (cdr subs_1) #f)) + (let ((app_0 (list* bstr_0 #vu8(47) accum_0))) + (loop_0 app_0 (cdr subs_1) #f))))) (if (eq? convention_0 'windows) (let ((len_0 (unsafe-bytes-length bstr_0))) (let ((combine_0 @@ -23123,7 +22913,8 @@ (list (starting-point-add-up (car accum_1))) (cdr accum_1)) #t)) - (loop_0 (cdr elems_0) (cons sub_0 accum_1) #f)))))))))) + (let ((app_0 (cdr elems_0))) + (loop_0 app_0 (cons sub_0 accum_1) #f))))))))))) (loop_0 (windows-split-into-path-elements bstr_0 is-last?_0) accum_0 @@ -23418,8 +23209,10 @@ (let ((s_0 (car elems_0))) (if (null? (cdr elems_0)) (let ((bstr_0 - (let ((app_0 (starting-point-bstr s_0))) - (subbytes app_0 0 (starting-point-orig-len s_0))))) + (subbytes + (starting-point-bstr s_0) + 0 + (starting-point-orig-len s_0)))) (if (equal? bstr_0 #vu8(92 92 63 92 82 69 76)) #vu8(46) (if (equal? bstr_0 #vu8(92 92 63 92 82 69 68)) @@ -23435,8 +23228,10 @@ (bytes-append bstr_0 #vu8(92))) bstr_0))))) (let ((init-bstr_0 - (let ((app_0 (starting-point-bstr s_0))) - (subbytes app_0 0 (starting-point-len s_0))))) + (subbytes + (starting-point-bstr s_0) + 0 + (starting-point-len s_0)))) (let ((app_0 (let ((tmp_0 (starting-point-kind s_0))) (if (if (eq? tmp_0 'rel) #t (eq? tmp_0 'red)) #vu8(92) #vu8())))) @@ -23716,22 +23511,18 @@ (if (starting-point-add-ups? s_0) (let ((bstr_0 (bytes-append - (let ((app_0 (starting-point-bstr s_0))) - (subbytes app_0 0 (starting-point-len s_0))) + (subbytes (starting-point-bstr s_0) 0 (starting-point-len s_0)) #vu8(92 46 46)))) (let ((len_0 (unsafe-bytes-length bstr_0))) (if (starting-point? s_0) - (let ((app_0 (starting-point-kind s_0))) - (let ((app_1 (starting-point-extra-sep s_0))) - (let ((app_2 (starting-point-add-ups? s_0))) - (starting-point7.1 - app_0 - bstr_0 - len_0 - len_0 - app_1 - app_2 - (starting-point-drive? s_0))))) + (starting-point7.1 + (starting-point-kind s_0) + bstr_0 + len_0 + len_0 + (starting-point-extra-sep s_0) + (starting-point-add-ups? s_0) + (starting-point-drive? s_0)) (raise-argument-error 'struct-copy "starting-point?" s_0)))) s_0))) (define simplify-dots.1 @@ -27253,54 +27044,56 @@ #f))) (finish-port/count (if user-peek-in9_0 - (create-core-input-port - (let ((app_0 - (core-input-port-methods-prepare-change.1 - core-input-port-vtable.1))) - (let ((app_1 - (if (1/input-port? - user-read-in8_0) - user-read-in8_0 - read-in_0))) - (let ((app_2 - (if (1/input-port? - user-peek-in9_0) - user-peek-in9_0 - peek-in_0))) - (let ((app_3 - (if (1/input-port? - user-peek-in9_0) - user-peek-in9_0 - byte-ready_0))) - (let ((app_4 - (if user-get-progress-evt1_0 - get-progress-evt_0 - #f))) - (core-input-port-methods6.1 - close_0 - count-lines!_0 - get-location_0 - file-position_0 - buffer-mode_0 - app_0 - app_1 - app_2 - app_3 - app_4 - (if user-commit2_0 - commit_0 - #f))))))) - name7_0 - (direct2.1 - #f - 0 - 0) - #f - #f - init-offset_0 - #f - #f - #f) + (let ((app_0 + (let ((app_0 + (core-input-port-methods-prepare-change.1 + core-input-port-vtable.1))) + (let ((app_1 + (if (1/input-port? + user-read-in8_0) + user-read-in8_0 + read-in_0))) + (let ((app_2 + (if (1/input-port? + user-peek-in9_0) + user-peek-in9_0 + peek-in_0))) + (let ((app_3 + (if (1/input-port? + user-peek-in9_0) + user-peek-in9_0 + byte-ready_0))) + (let ((app_4 + (if user-get-progress-evt1_0 + get-progress-evt_0 + #f))) + (core-input-port-methods6.1 + close_0 + count-lines!_0 + get-location_0 + file-position_0 + buffer-mode_0 + app_0 + app_1 + app_2 + app_3 + app_4 + (if user-commit2_0 + commit_0 + #f))))))))) + (create-core-input-port + app_0 + name7_0 + (direct2.1 + #f + 0 + 0) + #f + #f + init-offset_0 + #f + #f + #f)) (let ((app_0 (let ((app_0 (if buffer-mode_0 @@ -27314,62 +27107,54 @@ (temp9.1 self_0 mode_0)))))) - (let ((app_1 - (core-input-port-methods-prepare-change.1 - peek-via-read-input-port-vtable.1))) - (let ((app_2 - (core-input-port-methods-read-in.1 - peek-via-read-input-port-vtable.1))) - (let ((app_3 - (core-input-port-methods-peek-in.1 - peek-via-read-input-port-vtable.1))) - (let ((app_4 - (core-input-port-methods-byte-ready.1 - peek-via-read-input-port-vtable.1))) - (let ((app_5 - (core-input-port-methods-get-progress-evt.1 - peek-via-read-input-port-vtable.1))) - (peek-via-read-input-port-methods10.1 - (values - (lambda (self_0) - (begin - (close_0 - self_0) - (temp7.1 - self_0)))) - count-lines!_0 - get-location_0 - file-position_0 - app_0 - app_1 - app_2 - app_3 - app_4 - app_5 - (core-input-port-methods-commit.1 - peek-via-read-input-port-vtable.1) - read-in_0))))))))) - (create-peek-via-read-input-port - app_0 - name7_0 - (direct2.1 - #f - 0 - 0) - #f - #f - init-offset_0 - #f - #f - #f - #f - #f - (make-bytes - 4096) - 0 - 0 - #f - 'block)))))) + (peek-via-read-input-port-methods10.1 + (values + (lambda (self_0) + (begin + (close_0 + self_0) + (temp7.1 + self_0)))) + count-lines!_0 + get-location_0 + file-position_0 + app_0 + (core-input-port-methods-prepare-change.1 + peek-via-read-input-port-vtable.1) + (core-input-port-methods-read-in.1 + peek-via-read-input-port-vtable.1) + (core-input-port-methods-peek-in.1 + peek-via-read-input-port-vtable.1) + (core-input-port-methods-byte-ready.1 + peek-via-read-input-port-vtable.1) + (core-input-port-methods-get-progress-evt.1 + peek-via-read-input-port-vtable.1) + (core-input-port-methods-commit.1 + peek-via-read-input-port-vtable.1) + read-in_0)))) + (let ((app_1 + (direct2.1 + #f + 0 + 0))) + (create-peek-via-read-input-port + app_0 + name7_0 + app_1 + #f + #f + init-offset_0 + #f + #f + #f + #f + #f + (make-bytes + 4096) + 0 + 0 + #f + 'block))))))) (args (raise-binding-result-arity-error 2 @@ -28034,52 +27819,54 @@ user-close11_0) (unsafe-start-atomic))))))) (finish-port/count - (create-core-output-port - (let ((app_0 - (if (1/output-port? - user-write-out10_0) - user-write-out10_0 - write-out_0))) - (let ((app_1 - (if (1/output-port? - user-write-out-special1_0) - user-write-out-special1_0 - (if user-write-out-special1_0 - write-out-special_0 - #f)))) - (let ((app_2 - (if user-get-write-evt2_0 - get-write-evt_0 - #f))) - (core-output-port-methods6.1 - close_0 - count-lines!_0 - get-location_0 - file-position_0 - buffer-mode_0 - app_0 - app_1 - app_2 - (if user-get-write-special-evt3_0 - (lambda (self_0 - v_0) - (|#%app| - user-get-write-special-evt3_0 - v_0)) - #f))))) - name8_0 - (direct2.1 - #f - 0 - 0) - #f - #f - init-offset_0 - #f - evt9_0 - #f - #f - #f))))) + (let ((app_0 + (let ((app_0 + (if (1/output-port? + user-write-out10_0) + user-write-out10_0 + write-out_0))) + (let ((app_1 + (if (1/output-port? + user-write-out-special1_0) + user-write-out-special1_0 + (if user-write-out-special1_0 + write-out-special_0 + #f)))) + (let ((app_2 + (if user-get-write-evt2_0 + get-write-evt_0 + #f))) + (core-output-port-methods6.1 + close_0 + count-lines!_0 + get-location_0 + file-position_0 + buffer-mode_0 + app_0 + app_1 + app_2 + (if user-get-write-special-evt3_0 + (lambda (self_0 + v_0) + (|#%app| + user-get-write-special-evt3_0 + v_0)) + #f))))))) + (create-core-output-port + app_0 + name8_0 + (direct2.1 + #f + 0 + 0) + #f + #f + init-offset_0 + #f + evt9_0 + #f + #f + #f)))))) (args (raise-binding-result-arity-error 2 @@ -29754,10 +29541,11 @@ (let ((app_0 (cddr args_1))) (loop_0 app_0 - (hash-set - ht_0 - (normalize-key key_0) - (cons key_0 val_0))))))))))))))))) + (let ((app_1 (normalize-key key_0))) + (hash-set + ht_0 + app_1 + (cons key_0 val_0)))))))))))))))))) (loop_0 args_0 hash2725)))))) (define 1/environment-variables-ref (|#%name| @@ -30561,7 +30349,7 @@ (begin (if (is-path? p1_0) (void) (raise-argument-error 'path= c_0 97) (<= c_0 122) #f) - (loop_0 (cons c_0 accum_0) (add1 pos_2)) + (let ((app_0 (cons c_0 accum_0))) + (loop_0 app_0 (add1 pos_2))) (if (if (= c_0 58) (if (let ((app_0 (add1 pos_2))) (< app_0 (chytes-length$1 s_0))) @@ -3208,9 +3200,8 @@ (config-group-number+1 config_0))) (case-lambda ((rx_0 pos2_0) - (values - (begin-unsafe (rx:group3.1 rx_0 group-number_0)) - (check-close-paren s_0 pos2_0 config_0))) + (let ((app_0 (begin-unsafe (rx:group3.1 rx_0 group-number_0)))) + (values app_0 (check-close-paren s_0 pos2_0 config_0)))) (args (raise-binding-result-arity-error 2 args)))))))))) (define parse-look (lambda (s_0 pos2_0 config_0) @@ -3425,7 +3416,8 @@ pos3_0 config_0 "expected `)` after `(?(` followed by digits")) - (values (rx:reference10.1 n_0 #f) (add1 pos3_0)))) + (let ((app_0 (rx:reference10.1 n_0 #f))) + (values app_0 (add1 pos3_0))))) (args (raise-binding-result-arity-error 2 args))))) (parse-error s_0 @@ -4037,13 +4029,11 @@ (if (rx:repeat? rx_0) (if (rx:repeat? rx_0) (let ((rx3_0 (convert (rx:repeat-rx rx_0)))) - (let ((app_0 (rx:repeat-min rx_0))) - (let ((app_1 (rx:repeat-max rx_0))) - (rx:repeat4.1 - rx3_0 - app_0 - app_1 - (rx:repeat-non-greedy? rx_0))))) + (rx:repeat4.1 + rx3_0 + (rx:repeat-min rx_0) + (rx:repeat-max rx_0) + (rx:repeat-non-greedy? rx_0))) (raise-argument-error 'struct-copy "rx:repeat?" rx_0)) (if (rx:maybe? rx_0) (if (rx:maybe? rx_0) @@ -4059,18 +4049,14 @@ (convert (rx:conditional-rx_2094 rx_0)))) (let ((rx16_1 rx16_0) (tst5_1 tst5_0)) - (let ((app_0 - (rx:conditional-n-start rx_0))) - (let ((app_1 - (rx:conditional-num-n rx_0))) - (rx:conditional6.1 - tst5_1 - rx16_1 - rx27_0 - app_0 - app_1 - (rx:conditional-needs-backtrack? - rx_0)))))))) + (rx:conditional6.1 + tst5_1 + rx16_1 + rx27_0 + (rx:conditional-n-start rx_0) + (rx:conditional-num-n rx_0) + (rx:conditional-needs-backtrack? + rx_0)))))) (raise-argument-error 'struct-copy "rx:conditional?" @@ -4078,13 +4064,11 @@ (if (rx:lookahead? rx_0) (if (rx:lookahead? rx_0) (let ((rx8_0 (convert (rx:lookahead-rx rx_0)))) - (let ((app_0 (rx:lookahead-match? rx_0))) - (let ((app_1 (rx:lookahead-n-start rx_0))) - (rx:lookahead7.1 - rx8_0 - app_0 - app_1 - (rx:lookahead-num-n rx_0))))) + (rx:lookahead7.1 + rx8_0 + (rx:lookahead-match? rx_0) + (rx:lookahead-n-start rx_0) + (rx:lookahead-num-n rx_0))) (raise-argument-error 'struct-copy "rx:lookahead?" @@ -4093,19 +4077,13 @@ (if (rx:lookbehind? rx_0) (let ((rx9_0 (convert (rx:lookbehind-rx rx_0)))) - (let ((app_0 (rx:lookbehind-match? rx_0))) - (let ((app_1 (rx:lookbehind-lb-min rx_0))) - (let ((app_2 - (rx:lookbehind-lb-max rx_0))) - (let ((app_3 - (rx:lookbehind-n-start rx_0))) - (rx:lookbehind8.1 - rx9_0 - app_0 - app_1 - app_2 - app_3 - (rx:lookbehind-num-n rx_0))))))) + (rx:lookbehind8.1 + rx9_0 + (rx:lookbehind-match? rx_0) + (rx:lookbehind-lb-min rx_0) + (rx:lookbehind-lb-max rx_0) + (rx:lookbehind-n-start rx_0) + (rx:lookbehind-num-n rx_0))) (raise-argument-error 'struct-copy "rx:lookbehind?" @@ -4113,13 +4091,11 @@ (if (rx:cut? rx_0) (if (rx:cut? rx_0) (let ((rx10_0 (convert (rx:cut-rx rx_0)))) - (let ((app_0 (rx:cut-n-start rx_0))) - (let ((app_1 (rx:cut-num-n rx_0))) - (rx:cut9.1 - rx10_0 - app_0 - app_1 - (rx:cut-needs-backtrack? rx_0))))) + (rx:cut9.1 + rx10_0 + (rx:cut-n-start rx_0) + (rx:cut-num-n rx_0) + (rx:cut-needs-backtrack? rx_0))) (raise-argument-error 'struct-copy "rx:cut?" @@ -4151,10 +4127,11 @@ (void))))))) (if (> end_0 seg-end_0) (loop_0 - (cons - (cons start_1 seg-end_0) - (let ((app_0 (cons (add1 seg-end_0) end_0))) - (cons app_0 (cdr l_1))))) + (let ((app_0 (cons start_1 seg-end_0))) + (cons + app_0 + (let ((app_1 (cons (add1 seg-end_0) end_0))) + (cons app_1 (cdr l_1)))))) (if (<= end_0 127) (let ((app_0 (rx-range @@ -5018,14 +4995,13 @@ app_1 (lazy-bytes-skip-amt s_0) discarded-count_0)))) - (let ((app_2 (lazy-bytes-progress-evt s_0))) - (|#%app| - app_0 - bstr_0 - app_1 - app_2 - (lazy-bytes-in s_0) - len_0)))))) + (|#%app| + app_0 + bstr_0 + app_1 + (lazy-bytes-progress-evt s_0) + (lazy-bytes-in s_0) + len_0))))) (if (eof-object? n_0) #f (if (not (fixnum? n_0)) @@ -6808,7 +6784,8 @@ #f) (if (eq? c_0 'fail) #f - (loop_0 (add1 pos_1) (cons b_0 accum_0)))))))))))) + (let ((app_0 (add1 pos_1))) + (loop_0 app_0 (cons b_0 accum_0))))))))))))) (loop_0 pos_0 null))))) (define 1/compile (|#%name| @@ -6927,78 +6904,77 @@ (let ((min_0 (rx:repeat-min rx_1))) - (let ((max_0 - (let ((n_0 - (rx:repeat-max - rx_1))) + (let ((n_0 + (rx:repeat-max + rx_1))) + (let ((max_0 (if (= n_0 +inf.0) #f - n_0)))) - (let ((r-m*_0 - (compile*/maybe - r-rx_0 - min_0 - max_0))) - (if (if r-m*_0 - (not - (rx:repeat-non-greedy? - rx_1)) - #f) - (repeat-simple-many-matcher - r-m*_0 - min_0 - max_0 - group-n_0 - next-m_0) - (let ((r-m_0 - (compile_0 - r-rx_0 - (if simple?_0 - done-m - continue-m)))) - (if (rx:repeat-non-greedy? - rx_1) - (if simple?_0 - (lazy-repeat-simple-matcher - r-m_0 - min_0 - max_0 - next-m_0) - (lazy-repeat-matcher - r-m_0 - min_0 - max_0 - next-m_0)) - (if simple?_0 - (repeat-simple-matcher - r-m_0 - min_0 - max_0 - group-n_0 - next-m_0) - (repeat-matcher - r-m_0 - min_0 - max_0 - next-m_0)))))))))))) + n_0))) + (let ((r-m*_0 + (compile*/maybe + r-rx_0 + min_0 + max_0))) + (if (if r-m*_0 + (not + (rx:repeat-non-greedy? + rx_1)) + #f) + (repeat-simple-many-matcher + r-m*_0 + min_0 + max_0 + group-n_0 + next-m_0) + (let ((r-m_0 + (compile_0 + r-rx_0 + (if simple?_0 + done-m + continue-m)))) + (if (rx:repeat-non-greedy? + rx_1) + (if simple?_0 + (lazy-repeat-simple-matcher + r-m_0 + min_0 + max_0 + next-m_0) + (lazy-repeat-matcher + r-m_0 + min_0 + max_0 + next-m_0)) + (if simple?_0 + (repeat-simple-matcher + r-m_0 + min_0 + max_0 + group-n_0 + next-m_0) + (repeat-matcher + r-m_0 + min_0 + max_0 + next-m_0))))))))))))) (if (rx:group? rx_1) (let ((n_0 (rx:group-number rx_1))) - (let ((m_0 - (let ((app_0 - (rx:group-rx - rx_1))) + (let ((app_0 + (rx:group-rx rx_1))) + (let ((m_0 (compile_0 app_0 (group-set-matcher n_0 - next-m_0))))) - (group-push-matcher - n_0 - m_0))) + next-m_0)))) + (group-push-matcher + n_0 + m_0)))) (if (rx:reference? rx_1) (let ((n_0 (rx:reference-n @@ -7018,14 +6994,11 @@ (compile_0 (rx:cut-rx rx_1) done-m))) - (let ((app_1 - (rx:cut-n-start - rx_1))) - (cut-matcher - app_0 - app_1 - (rx:cut-num-n rx_1) - next-m_0))) + (cut-matcher + app_0 + (rx:cut-n-start rx_1) + (rx:cut-num-n rx_1) + next-m_0)) (if (rx:conditional? rx_1) (let ((tst_0 (rx:conditional-tst @@ -7054,16 +7027,14 @@ (compile_0 tst_0 done-m))) - (let ((app_1 - (rx:conditional-n-start - rx_1))) - (conditional/look-matcher - app_0 - m1_0 - m2_0 - app_1 - (rx:conditional-num-n - rx_1)))))))) + (conditional/look-matcher + app_0 + m1_0 + m2_0 + (rx:conditional-n-start + rx_1) + (rx:conditional-num-n + rx_1))))))) (if (rx:lookahead? rx_1) (let ((app_0 (rx:lookahead-match? @@ -7073,16 +7044,14 @@ (rx:lookahead-rx rx_1) done-m))) - (let ((app_2 - (rx:lookahead-n-start - rx_1))) - (lookahead-matcher - app_0 - app_1 - app_2 - (rx:lookahead-num-n - rx_1) - next-m_0)))) + (lookahead-matcher + app_0 + app_1 + (rx:lookahead-n-start + rx_1) + (rx:lookahead-num-n + rx_1) + next-m_0))) (if (rx:lookbehind? rx_1) (let ((app_0 @@ -7099,28 +7068,24 @@ (rx:lookbehind-rx rx_1) limit-m))) - (let ((app_4 - (rx:lookbehind-n-start - rx_1))) - (lookbehind-matcher - app_0 - app_1 - app_2 - app_3 - app_4 - (rx:lookbehind-num-n - rx_1) - next-m_0)))))) + (lookbehind-matcher + app_0 + app_1 + app_2 + app_3 + (rx:lookbehind-n-start + rx_1) + (rx:lookbehind-num-n + rx_1) + next-m_0))))) (if (rx:unicode-categories? rx_1) - (let ((app_0 - (rx:unicode-categories-symlist - rx_1))) - (unicode-categories-matcher - app_0 - (rx:unicode-categories-match? - rx_1) - next-m_0)) + (unicode-categories-matcher + (rx:unicode-categories-symlist + rx_1) + (rx:unicode-categories-match? + rx_1) + next-m_0) (error 'compile/bt "internal error: unrecognized ~s" @@ -7139,7 +7104,7 @@ #f)))))) (define struct:rx:regexp (make-record-type-descriptor* 'regexp #f #f #f #f 10 0)) -(define effect_2093 +(define effect_2629 (struct-type-install-properties! struct:rx:regexp 'regexp @@ -7151,9 +7116,8 @@ prop:equal+hash (list (lambda (a_0 b_0 eql?_0) - (if (let ((app_0 (rx:regexp-px? a_0))) (eq? app_0 (rx:regexp-px? b_0))) - (let ((app_0 (rx:regexp-source a_0))) - (equal? app_0 (rx:regexp-source b_0))) + (if (eq? (rx:regexp-px? a_0) (rx:regexp-px? b_0)) + (equal? (rx:regexp-source a_0) (rx:regexp-source b_0)) #f)) (lambda (a_0 hc_0) (|#%app| hc_0 (rx:regexp-source a_0))) (lambda (a_0 hc_0) (|#%app| hc_0 (rx:regexp-source a_0))))) @@ -7564,7 +7528,8 @@ (let ((app_0 (+ ms-pos3_0 delta1_0))) (cons app_0 (+ me-pos4_0 delta1_0)))) (if (zero? delta1_0) - (cons (cons ms-pos3_0 me-pos4_0) (vector->list state5_0)) + (let ((app_0 (cons ms-pos3_0 me-pos4_0))) + (cons app_0 (vector->list state5_0))) (let ((app_0 (let ((app_0 (+ ms-pos3_0 delta1_0))) (cons app_0 (+ me-pos4_0 delta1_0))))) @@ -8134,26 +8099,26 @@ (args (raise-binding-result-arity-error 2 args)))))))) (define fast-drive-regexp-match-positions/bytes (lambda (rx_0 in_0 start-pos_0 end-pos_0) - (let ((state_0 - (let ((n_0 (rx:regexp-num-groups rx_0))) - (if (positive? n_0) (make-vector n_0 #f) #f)))) - (call-with-values - (lambda () - (search-match - rx_0 - in_0 - start-pos_0 - start-pos_0 - (if end-pos_0 end-pos_0 (unsafe-bytes-length in_0)) - state_0)) - (case-lambda - ((ms-pos_0 me-pos_0) - (if ms-pos_0 - (if state_0 - (cons (cons ms-pos_0 me-pos_0) (vector->list state_0)) - (list (cons ms-pos_0 me-pos_0))) - #f)) - (args (raise-binding-result-arity-error 2 args))))))) + (let ((n_0 (rx:regexp-num-groups rx_0))) + (let ((state_0 (if (positive? n_0) (make-vector n_0 #f) #f))) + (call-with-values + (lambda () + (search-match + rx_0 + in_0 + start-pos_0 + start-pos_0 + (if end-pos_0 end-pos_0 (unsafe-bytes-length in_0)) + state_0)) + (case-lambda + ((ms-pos_0 me-pos_0) + (if ms-pos_0 + (if state_0 + (let ((app_0 (cons ms-pos_0 me-pos_0))) + (cons app_0 (vector->list state_0))) + (list (cons ms-pos_0 me-pos_0))) + #f)) + (args (raise-binding-result-arity-error 2 args)))))))) (define fast-drive-regexp-match-positions/string (lambda (rx_0 in-str_0 start-offset_0 end-offset_0) (let ((in_0 @@ -8162,149 +8127,87 @@ 0 start-offset_0 (if end-offset_0 end-offset_0 (string-length in-str_0))))) - (let ((state_0 - (let ((n_0 (rx:regexp-num-groups rx_0))) - (if (positive? n_0) (make-vector n_0 #f) #f)))) - (call-with-values - (lambda () - (search-match rx_0 in_0 0 0 (unsafe-bytes-length in_0) state_0)) - (case-lambda - ((ms-pos_0 me-pos_0) - (let ((string-offset_0 - (|#%name| - string-offset - (lambda (pos_0) - (begin - (+ - start-offset_0 - (bytes-utf-8-length in_0 '#\x3f 0 pos_0))))))) - (if ms-pos_0 - (let ((app_0 - (let ((app_0 (string-offset_0 ms-pos_0))) - (cons app_0 (string-offset_0 me-pos_0))))) - (cons - app_0 - (if state_0 - (reverse$1 - (call-with-values - (lambda () - (begin - (check-vector state_0) - (values state_0 (unsafe-vector-length state_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((p_0 - (unsafe-vector-ref vec_0 pos_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if p_0 - (let ((app_1 - (string-offset_0 - (car p_0)))) - (cons - app_1 - (string-offset_0 - (cdr p_0)))) - #f) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - (unsafe-fx+ 1 pos_0)))) - fold-var_0)))))) - (for-loop_0 null 0)))) - (args (raise-binding-result-arity-error 2 args))))) - null))) - #f))) - (args (raise-binding-result-arity-error 2 args)))))))) + (let ((n_0 (rx:regexp-num-groups rx_0))) + (let ((state_0 (if (positive? n_0) (make-vector n_0 #f) #f))) + (call-with-values + (lambda () + (search-match rx_0 in_0 0 0 (unsafe-bytes-length in_0) state_0)) + (case-lambda + ((ms-pos_0 me-pos_0) + (let ((string-offset_0 + (|#%name| + string-offset + (lambda (pos_0) + (begin + (+ + start-offset_0 + (bytes-utf-8-length in_0 '#\x3f 0 pos_0))))))) + (if ms-pos_0 + (let ((app_0 + (let ((app_0 (string-offset_0 ms-pos_0))) + (cons app_0 (string-offset_0 me-pos_0))))) + (cons + app_0 + (if state_0 + (reverse$1 + (call-with-values + (lambda () + (begin + (check-vector state_0) + (values state_0 (unsafe-vector-length state_0)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 pos_0) + (begin + (if (unsafe-fx< pos_0 len_0) + (let ((p_0 + (unsafe-vector-ref vec_0 pos_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if p_0 + (let ((app_1 + (string-offset_0 + (car p_0)))) + (cons + app_1 + (string-offset_0 + (cdr p_0)))) + #f) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + (unsafe-fx+ 1 pos_0)))) + fold-var_0)))))) + (for-loop_0 null 0)))) + (args (raise-binding-result-arity-error 2 args))))) + null))) + #f))) + (args (raise-binding-result-arity-error 2 args))))))))) (define fast-drive-regexp-match/bytes (lambda (rx_0 in_0 start-pos_0 end-pos_0) - (let ((state_0 - (let ((n_0 (rx:regexp-num-groups rx_0))) - (if (positive? n_0) (make-vector n_0 #f) #f)))) - (call-with-values - (lambda () - (search-match - rx_0 - in_0 - start-pos_0 - start-pos_0 - (if end-pos_0 end-pos_0 (unsafe-bytes-length in_0)) - state_0)) - (case-lambda - ((ms-pos_0 me-pos_0) - (if ms-pos_0 - (let ((app_0 (subbytes in_0 ms-pos_0 me-pos_0))) - (cons - app_0 - (if state_0 - (reverse$1 - (call-with-values - (lambda () - (begin - (check-vector state_0) - (values state_0 (unsafe-vector-length state_0)))) - (case-lambda - ((vec_0 len_0) - (begin - #f - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 pos_0) - (begin - (if (unsafe-fx< pos_0 len_0) - (let ((p_0 (unsafe-vector-ref vec_0 pos_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (if p_0 - (let ((app_1 (car p_0))) - (subbytes - in_0 - app_1 - (cdr p_0))) - #f) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - (unsafe-fx+ 1 pos_0)))) - fold-var_0)))))) - (for-loop_0 null 0)))) - (args (raise-binding-result-arity-error 2 args))))) - null))) - #f)) - (args (raise-binding-result-arity-error 2 args))))))) -(define fast-drive-regexp-match/string - (lambda (rx_0 in-str_0 start-offset_0 end-offset_0) - (let ((in_0 - (string->bytes/utf-8 - in-str_0 - 0 - start-offset_0 - (if end-offset_0 end-offset_0 (string-length in-str_0))))) - (let ((state_0 - (let ((n_0 (rx:regexp-num-groups rx_0))) - (if (positive? n_0) (make-vector n_0 #f) #f)))) + (let ((n_0 (rx:regexp-num-groups rx_0))) + (let ((state_0 (if (positive? n_0) (make-vector n_0 #f) #f))) (call-with-values (lambda () - (search-match rx_0 in_0 0 0 (unsafe-bytes-length in_0) state_0)) + (search-match + rx_0 + in_0 + start-pos_0 + start-pos_0 + (if end-pos_0 end-pos_0 (unsafe-bytes-length in_0)) + state_0)) (case-lambda ((ms-pos_0 me-pos_0) (if ms-pos_0 - (let ((app_0 (bytes->string/utf-8 in_0 '#\x3f ms-pos_0 me-pos_0))) + (let ((app_0 (subbytes in_0 ms-pos_0 me-pos_0))) (cons app_0 (if state_0 @@ -8331,9 +8234,8 @@ (cons (if p_0 (let ((app_1 (car p_0))) - (bytes->string/utf-8 + (subbytes in_0 - '#\x3f app_1 (cdr p_0))) #f) @@ -8348,6 +8250,68 @@ null))) #f)) (args (raise-binding-result-arity-error 2 args)))))))) +(define fast-drive-regexp-match/string + (lambda (rx_0 in-str_0 start-offset_0 end-offset_0) + (let ((in_0 + (string->bytes/utf-8 + in-str_0 + 0 + start-offset_0 + (if end-offset_0 end-offset_0 (string-length in-str_0))))) + (let ((n_0 (rx:regexp-num-groups rx_0))) + (let ((state_0 (if (positive? n_0) (make-vector n_0 #f) #f))) + (call-with-values + (lambda () + (search-match rx_0 in_0 0 0 (unsafe-bytes-length in_0) state_0)) + (case-lambda + ((ms-pos_0 me-pos_0) + (if ms-pos_0 + (let ((app_0 + (bytes->string/utf-8 in_0 '#\x3f ms-pos_0 me-pos_0))) + (cons + app_0 + (if state_0 + (reverse$1 + (call-with-values + (lambda () + (begin + (check-vector state_0) + (values state_0 (unsafe-vector-length state_0)))) + (case-lambda + ((vec_0 len_0) + (begin + #f + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 pos_0) + (begin + (if (unsafe-fx< pos_0 len_0) + (let ((p_0 + (unsafe-vector-ref vec_0 pos_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (if p_0 + (let ((app_1 (car p_0))) + (bytes->string/utf-8 + in_0 + '#\x3f + app_1 + (cdr p_0))) + #f) + fold-var_0))) + (values fold-var_1)))) + (for-loop_0 + fold-var_1 + (unsafe-fx+ 1 pos_0)))) + fold-var_0)))))) + (for-loop_0 null 0)))) + (args (raise-binding-result-arity-error 2 args))))) + null))) + #f)) + (args (raise-binding-result-arity-error 2 args))))))))) (define drive-regexp-match.1 (|#%name| drive-regexp-match diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index a6f20cbe4a..226c0b7a04 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -2857,14 +2857,14 @@ (if (impersonator? v) (known-procedure/succeeds?_3041 (impersonator-val v)) #f)))))) -(define struct:known-procedure/pure +(define struct:known-procedure/allocates (make-record-type-descriptor* - 'known-procedure/pure + 'known-procedure/allocates (if (struct-type? struct:known-procedure/succeeds) struct:known-procedure/succeeds (check-struct-type 'struct struct:known-procedure/succeeds)) (structure-type-lookup-prefab-uid - 'known-procedure/pure + 'known-procedure/allocates (if (struct-type? struct:known-procedure/succeeds) struct:known-procedure/succeeds (check-struct-type 'struct struct:known-procedure/succeeds)) @@ -2876,10 +2876,10 @@ #f 0 0)) -(define effect_2377 +(define effect_2234 (struct-type-install-properties! - struct:known-procedure/pure - 'known-procedure/pure + struct:known-procedure/allocates + 'known-procedure/allocates 0 0 (if (struct-type? struct:known-procedure/succeeds) @@ -2890,6 +2890,62 @@ #f '() #f + 'known-procedure/allocates)) +(define known-procedure/allocates + (|#%name| + known-procedure/allocates + (record-constructor + (make-record-constructor-descriptor + struct:known-procedure/allocates + #f + #f)))) +(define known-procedure/allocates?_2244 + (|#%name| + known-procedure/allocates? + (record-predicate struct:known-procedure/allocates))) +(define known-procedure/allocates? + (|#%name| + known-procedure/allocates? + (lambda (v) + (if (known-procedure/allocates?_2244 v) + #t + ($value + (if (impersonator? v) + (known-procedure/allocates?_2244 (impersonator-val v)) + #f)))))) +(define struct:known-procedure/pure + (make-record-type-descriptor* + 'known-procedure/pure + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + (structure-type-lookup-prefab-uid + 'known-procedure/pure + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + 0 + 0 + #f + '()) + #f + #f + 0 + 0)) +(define effect_2568 + (struct-type-install-properties! + struct:known-procedure/pure + 'known-procedure/pure + 0 + 0 + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) + null + 'prefab + #f + '() + #f 'known-procedure/pure)) (define known-procedure/pure (|#%name| @@ -3353,14 +3409,14 @@ (define struct:known-constructor (make-record-type-descriptor* 'known-constructor - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) (structure-type-lookup-prefab-uid 'known-constructor - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) 1 0 #f @@ -3369,15 +3425,15 @@ #f 1 1)) -(define effect_2019 +(define effect_2907 (struct-type-install-properties! struct:known-constructor 'known-constructor 1 0 - (if (struct-type? struct:known-procedure/pure) - struct:known-procedure/pure - (check-struct-type 'struct struct:known-procedure/pure)) + (if (struct-type? struct:known-procedure/allocates) + struct:known-procedure/allocates + (check-struct-type 'struct struct:known-procedure/allocates)) null 'prefab #f @@ -4638,9 +4694,7 @@ (if converter_0 (|#%app| converter_0 v_0) v_0)) v_0)))) (define import-lookup - (lambda (im_0) - (let ((app_0 (import-grp im_0))) - (import-group-lookup app_0 (import-ext-id im_0))))) + (lambda (im_0) (import-group-lookup (import-grp im_0) (import-ext-id im_0)))) (define hash-ref-either (lambda (knowns_0 imports_0 key_0) (let ((or-part_0 (hash-ref knowns_0 key_0 #f))) @@ -4681,8 +4735,8 @@ (find-or-add-import-from-group! grp_0 ext-id_0 imports_0))))))) (define find-or-add-import-from-group! (lambda (grp_0 ext-id_0 imports_0) - (let ((or-part_0 - (let ((lst_0 (import-group-imports grp_0))) + (let ((lst_0 (import-group-imports grp_0))) + (let ((or-part_0 (begin (letrec* ((for-loop_0 @@ -4707,19 +4761,19 @@ (for-loop_0 result_1 rest_0) result_1)))) result_0)))))) - (for-loop_0 #f lst_0)))))) - (if or-part_0 - or-part_0 - (let ((id_0 (deterministic-gensym ext-id_0))) - (let ((int-id_0 (deterministic-gensym ext-id_0))) - (let ((id_1 id_0)) - (let ((im_0 (import1.1 grp_0 id_1 int-id_0 ext-id_0))) - (begin - (set-import-group-imports! - grp_0 - (cons im_0 (import-group-imports grp_0))) - (hash-set! imports_0 int-id_0 im_0) - int-id_0))))))))) + (for-loop_0 #f lst_0))))) + (if or-part_0 + or-part_0 + (let ((id_0 (deterministic-gensym ext-id_0))) + (let ((int-id_0 (deterministic-gensym ext-id_0))) + (let ((id_1 id_0)) + (let ((im_0 (import1.1 grp_0 id_1 int-id_0 ext-id_0))) + (begin + (set-import-group-imports! + grp_0 + (cons im_0 (import-group-imports grp_0))) + (hash-set! imports_0 int-id_0 im_0) + int-id_0)))))))))) (define find-or-add-import-group! (lambda (grps_0 key_0 @@ -4947,14 +5001,16 @@ (define simple?.1 (|#%name| simple? - (lambda (pure?1_0 - result-arity2_0 - e5_0 - prim-knowns6_0 - knowns7_0 - imports8_0 - mutated9_0 - simples10_0) + (lambda (no-alloc?2_0 + pure?1_0 + result-arity3_0 + e7_0 + prim-knowns8_0 + knowns9_0 + imports10_0 + mutated11_0 + simples12_0 + unsafe-mode?13_0) (begin (letrec* ((simple?_0 @@ -4978,14 +5034,17 @@ (begin (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 - '#(unknown unknown 1)))) - (let ((r_0 (vector-ref c_0 (if pure?1_0 0 1)))) + '#(unknown unknown unknown 1)))) + (let ((r_0 + (vector-ref + c_0 + (if pure?1_0 (if no-alloc?2_0 1 0) 2)))) (let ((arity-match?_0 (eqv? result-arity_0 - (vector-ref c_0 2)))) + (vector-ref c_0 3)))) (if (let ((or-part_0 (eq? 'unknown r_0))) (if or-part_0 or-part_0 @@ -5009,21 +5068,43 @@ (loop_0 es_0)))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))))))) (let ((hd_0 @@ -5200,14 +5281,14 @@ idss_2 rhss_1)))))) (case-lambda - ((idss12_0 - rhss13_0) + ((idss15_0 + rhss16_0) (values (cons - idss12_0 + idss15_0 idss_0) (cons - rhss13_0 + rhss16_0 rhss_0))) (args (raise-binding-result-arity-error @@ -5266,15 +5347,19 @@ ((idss_0 rhss_0 body_0) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 - '#(unknown unknown 1)))) + '#(unknown unknown unknown 1)))) (let ((r_0 - (vector-ref c_0 (if pure?1_0 0 1)))) + (vector-ref + c_0 + (if pure?1_0 + (if no-alloc?2_0 1 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 - (vector-ref c_0 2)))) + (vector-ref c_0 3)))) (if (let ((or-part_0 (eq? 'unknown r_0))) (if or-part_0 @@ -5346,21 +5431,43 @@ #f))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (args @@ -5501,7 +5608,7 @@ v_0)) (let ((rhss_1 (let ((rhss_1 - (let ((rhss14_0 + (let ((rhss17_0 (let ((d_1 (cdr (unwrap @@ -5512,7 +5619,7 @@ d_1)))) a_1)))) (cons - rhss14_0 + rhss17_0 rhss_0)))) (values rhss_1)))) @@ -5535,17 +5642,19 @@ ((rhss_0 body_0) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 - '#(unknown unknown 1)))) + '#(unknown unknown unknown 1)))) (let ((r_0 (vector-ref c_0 - (if pure?1_0 0 1)))) + (if pure?1_0 + (if no-alloc?2_0 1 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 - (vector-ref c_0 2)))) + (vector-ref c_0 3)))) (if (let ((or-part_0 (eq? 'unknown r_0))) (if or-part_0 @@ -5597,21 +5706,47 @@ #f))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref c_0 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (args @@ -5791,14 +5926,14 @@ idss_2 rhss_1)))))) (case-lambda - ((idss15_0 - rhss16_0) + ((idss18_0 + rhss19_0) (values (cons - idss15_0 + idss18_0 idss_0) (cons - rhss16_0 + rhss19_0 rhss_0))) (args (raise-binding-result-arity-error @@ -5865,17 +6000,19 @@ ((idss_0 rhss_0 body_0) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 - '#(unknown unknown 1)))) + '#(unknown unknown unknown 1)))) (let ((r_0 (vector-ref c_0 - (if pure?1_0 0 1)))) + (if pure?1_0 + (if no-alloc?2_0 1 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 - (vector-ref c_0 2)))) + (vector-ref c_0 3)))) (if (let ((or-part_0 (eq? 'unknown r_0))) (if or-part_0 @@ -5947,21 +6084,49 @@ #f))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref c_0 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (args @@ -6134,14 +6299,14 @@ ids_2 rhss_1)))))) (case-lambda - ((ids17_0 - rhss18_0) + ((ids20_0 + rhss21_0) (values (cons - ids17_0 + ids20_0 ids_0) (cons - rhss18_0 + rhss21_0 rhss_0))) (args (raise-binding-result-arity-error @@ -6208,17 +6373,22 @@ ((ids_0 rhss_0 body_0) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 - '#(unknown unknown 1)))) + '#(unknown + unknown + unknown + 1)))) (let ((r_0 (vector-ref c_0 - (if pure?1_0 0 1)))) + (if pure?1_0 + (if no-alloc?2_0 1 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 - (vector-ref c_0 2)))) + (vector-ref c_0 3)))) (if (let ((or-part_0 (eq? 'unknown r_0))) (if or-part_0 @@ -6270,21 +6440,53 @@ #f))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref c_0 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref c_0 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref c_0 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (args @@ -6337,17 +6539,22 @@ ((e0_0 es_0) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 - '#(unknown unknown 1)))) + '#(unknown + unknown + unknown + 1)))) (let ((r_0 (vector-ref c_0 - (if pure?1_0 0 1)))) + (if pure?1_0 + (if no-alloc?2_0 1 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 - (vector-ref c_0 2)))) + (vector-ref c_0 3)))) (if (let ((or-part_0 (eq? 'unknown @@ -6402,25 +6609,55 @@ #f))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref - c_0 - 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref - c_0 - 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (args @@ -6481,21 +6718,26 @@ (unwrap-list d_0)))) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 '#(unknown + unknown unknown 1)))) (let ((r_0 (vector-ref c_0 - (if pure?1_0 0 1)))) + (if pure?1_0 + (if no-alloc?2_0 + 1 + 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 (vector-ref c_0 - 2)))) + 3)))) (if (let ((or-part_0 (eq? 'unknown @@ -6550,25 +6792,55 @@ #f))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref - c_0 - 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref - c_0 - 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (if (let ((p_0 (unwrap e_0))) @@ -6594,23 +6866,26 @@ ((proc_0 args_0) (let ((c_0 (hash-ref - simples10_0 + simples12_0 e_0 '#(unknown + unknown unknown 1)))) (let ((r_0 (vector-ref c_0 (if pure?1_0 - 0 - 1)))) + (if no-alloc?2_0 + 1 + 0) + 2)))) (let ((arity-match?_0 (eqv? result-arity_0 (vector-ref c_0 - 2)))) + 3)))) (if (let ((or-part_0 (eq? 'unknown @@ -6628,18 +6903,28 @@ (if (let ((v_0 (let ((or-part_0 (hash-ref-either - knowns7_0 - imports8_0 + knowns9_0 + imports10_0 proc_1))) (if or-part_0 or-part_0 (hash-ref - prim-knowns6_0 + prim-knowns8_0 proc_1 #f))))) (if (if pure?1_0 - (if (known-procedure/pure? - v_0) + (if (if no-alloc?2_0 + (known-procedure/pure? + v_0) + (let ((or-part_0 + (known-procedure/allocates? + v_0))) + (if or-part_0 + or-part_0 + (if unsafe-mode?13_0 + (known-accessor? + v_0) + #f)))) (returns_0 1) #f) @@ -6664,7 +6949,7 @@ #f)) (if (simple-mutated-state? (hash-ref - mutated9_0 + mutated11_0 proc_1 #f)) (begin @@ -6711,25 +6996,55 @@ #f)))) (begin (hash-set! - simples10_0 + simples12_0 e_0 (if pure?1_0 - (vector - r_1 - (if arity-match?_0 - (vector-ref - c_0 - 1) - 'unknown) - result-arity_0) - (vector - (if arity-match?_0 - (vector-ref - c_0 - 0) - 'unknown) - r_1 - result-arity_0))) + (if no-alloc?2_0 + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + r_1 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0)) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown))) + (vector + r_1 + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 2) + 'unknown) + result-arity_0))) + (let ((app_0 + (if arity-match?_0 + (vector-ref + c_0 + 0) + 'unknown))) + (vector + app_0 + (if arity-match?_0 + (vector-ref + c_0 + 1) + 'unknown) + r_1 + result-arity_0)))) r_1)) r_0))))) (args @@ -6742,7 +7057,7 @@ (if (symbol? e_1) (simple-mutated-state? (hash-ref - mutated9_0 + mutated11_0 e_1 #f)) #f))) @@ -6771,7 +7086,7 @@ (regexp? e_1))))))))))) #f)))))))))))))))))))))))) - (simple?_0 e5_0 result-arity2_0)))))) + (simple?_0 e7_0 result-arity3_0)))))) (define simple/can-copy? (lambda (e_0 prim-knowns_0 knowns_0 imports_0 mutated_0) (let ((hd_0 @@ -8343,6 +8658,7 @@ 2 args)))))) (simple?.1 + #f #t 1 val_0 @@ -8350,7 +8666,8 @@ knowns_0 imports_0 mutated_0 - simples_0) + simples_0 + #f) #f) #f)))) (values result_1)))) @@ -10648,9 +10965,8 @@ (let ((m_0 (hash-ref mutated_0 u_0 #f))) (begin (if m_0 (hash-set! mutated_0 g_0 m_0) (void)) - (cons - (cons u_0 g_0) - (loop_0 (wrap-cdr args_1))))))) + (let ((app_0 (cons u_0 g_0))) + (cons app_0 (loop_0 (wrap-cdr args_1)))))))) (let ((u_0 (unwrap args_1))) (cons (cons u_0 (deterministic-gensym u_0)) @@ -11386,8 +11702,9 @@ app_1 app_2 (begin-unsafe (hash-map needed_0 cons #t)))))) - (let ((app_0 (known-procedure-arity-mask k_0))) - (known-constructor app_0 (known-constructor-type k_0))))) + (known-constructor + (known-procedure-arity-mask k_0) + (known-constructor-type k_0)))) (if (known-struct-predicate? k_0) (let ((needed_0 (needed-imports @@ -11408,8 +11725,9 @@ app_2 app_3 (begin-unsafe (hash-map needed_0 cons #t))))))) - (let ((app_0 (known-procedure-arity-mask k_0))) - (known-predicate app_0 (known-predicate-type k_0))))) + (known-predicate + (known-procedure-arity-mask k_0) + (known-predicate-type k_0)))) (if (known-field-accessor? k_0) (let ((needed_0 (needed-imports @@ -11430,8 +11748,9 @@ app_2 app_3 (begin-unsafe (hash-map needed_0 cons #t))))))) - (let ((app_0 (known-procedure-arity-mask k_0))) - (known-accessor app_0 (known-accessor-type k_0))))) + (known-accessor + (known-procedure-arity-mask k_0) + (known-accessor-type k_0)))) (if (known-field-mutator? k_0) (let ((needed_0 (needed-imports @@ -11452,8 +11771,9 @@ app_2 app_3 (begin-unsafe (hash-map needed_0 cons #t))))))) - (let ((app_0 (known-procedure-arity-mask k_0))) - (known-mutator app_0 (known-mutator-type k_0))))) + (known-mutator + (known-procedure-arity-mask k_0) + (known-mutator-type k_0)))) k_0))))))) (define needed-imports (lambda (v_0 prim-knowns_0 imports_0 exports_0 env_0 needed_0) @@ -11908,12 +12228,10 @@ (hash-set needed_0 u-v_0 - (let ((app_0 - (import-ext-id c2_0))) - (cons - app_0 - (import-group-index - (import-grp c2_0))))) + (cons + (import-ext-id c2_0) + (import-group-index + (import-grp c2_0)))) #f))))) needed_0)))))))))))))))) #f))) @@ -12242,7 +12560,7 @@ knowns_0 imports_0 u_0))))) - (let ((or-part_0 (known-procedure/pure? k_0))) + (let ((or-part_0 (known-procedure/allocates? k_0))) (if or-part_0 or-part_0 (known-procedure/single-valued? k_0)))) @@ -12855,6 +13173,7 @@ (loop_0 e_0)) (if (if defn8_0 (simple?.1 + #f #t 1 rhs_0 @@ -12862,7 +13181,8 @@ knowns10_0 imports12_0 mutated13_0 - simples14_0) + simples14_0 + unsafe-mode?15_0) #f) a-known-constant #f))))))))))))))) @@ -13757,14 +14077,14 @@ (let ((v_2 v_1)) (let ((argss_1 (let ((argss_1 - (let ((argss61_0 + (let ((argss62_0 (let ((a_0 (car (unwrap v_2)))) a_0))) (cons - argss61_0 + argss62_0 argss_0)))) (values argss_1)))) (for-loop_0 argss_1 rest_0))))) @@ -13897,10 +14217,10 @@ argss_2 bodys_1)))))) (case-lambda - ((argss62_0 bodys63_0) + ((argss63_0 bodys64_0) (values - (cons argss62_0 argss_0) - (cons bodys63_0 bodys_0))) + (cons argss63_0 argss_0) + (cons bodys64_0 bodys_0))) (args (raise-binding-result-arity-error 2 @@ -14647,10 +14967,10 @@ type_0 struct:s_0 (struct-type-info-authentic? info_0)))))) - (let ((knowns_2 - (let ((immediate-count_0 - (struct-type-info-immediate-field-count - info_0))) + (let ((immediate-count_0 + (struct-type-info-immediate-field-count + info_0))) + (let ((knowns_2 (let ((parent-count_0 (- (struct-type-info-field-count @@ -14945,20 +15265,18 @@ (for-loop_0 knowns_1 acc/muts_0 - make-acc/muts_0))))))) - (values - (let ((app_0 (unwrap struct:s_0))) - (hash-set - knowns_2 - app_0 - (let ((app_1 - (struct-type-info-field-count info_0))) + make-acc/muts_0)))))) + (values + (let ((app_0 (unwrap struct:s_0))) + (hash-set + knowns_2 + app_0 (known-struct-type type_0 - app_1 + (struct-type-info-field-count info_0) (struct-type-info-pure-constructor? - info_0))))) - info_0))))) + info_0)))) + info_0)))))) (values knowns7_0 #f)))) (args (raise-binding-result-arity-error 14 args)))) (if (if (eq? 'define-values hd_0) @@ -15147,13 +15465,11 @@ (hash-set knowns_1 app_0 - (let ((app_1 - (struct-type-info-field-count info_0))) - (known-struct-type - type_0 - app_1 - (struct-type-info-pure-constructor? - info_0))))))) + (known-struct-type + type_0 + (struct-type-info-field-count info_0) + (struct-type-info-pure-constructor? + info_0)))))) info_0)) (values knowns7_0 #f)))) (args (raise-binding-result-arity-error 6 args)))) @@ -15257,25 +15573,28 @@ (symbol->string (unwrap prop:s_0))))) (values (let ((knowns_0 - (hash-set - knowns7_0 - (unwrap s-ref_0) - (known-accessor 2 type_0)))) - (let ((knowns_1 + (let ((app_0 (unwrap s-ref_0))) (hash-set - knowns_0 - (unwrap s?_0) - (known-predicate 2 type_0)))) + knowns7_0 + app_0 + (known-accessor 2 type_0))))) + (let ((knowns_1 + (let ((app_0 (unwrap s?_0))) + (hash-set + knowns_0 + app_0 + (known-predicate 2 type_0))))) (if (let ((or-part_0 (null? (unwrap rest_0)))) (if or-part_0 or-part_0 (if (not (wrap-car rest_0)) (null? (unwrap (wrap-cdr rest_0))) #f))) - (hash-set - knowns_1 - (unwrap prop:s_0) - (known-struct-type-property/immediate-guard)) + (let ((app_0 (unwrap prop:s_0))) + (hash-set + knowns_1 + app_0 + (known-struct-type-property/immediate-guard))) knowns_1))) #f))) (args (raise-binding-result-arity-error 4 args)))) @@ -16502,20 +16821,18 @@ (struct-type-info-parent sti_0) knowns_0))) - (let ((app_4 - (struct-type-info-immediate-field-count - sti_0))) - (list - 'structure-type-lookup-prefab-uid - app_2 - app_3 - app_4 - 0 - #f - (list - 'quote - (struct-type-info-prefab-immutables - sti_0))))))))) + (list + 'structure-type-lookup-prefab-uid + app_2 + app_3 + (struct-type-info-immediate-field-count + sti_0) + 0 + #f + (list + 'quote + (struct-type-info-prefab-immutables + sti_0)))))))) (let ((app_3 (struct-type-info-immediate-field-count sti_0))) @@ -16718,25 +17035,21 @@ (list 'record-predicate struct:s_0))) - (let ((post_1 post_0) - (sep_1 sep_0) - (st_1 st_0) - (pre_1 pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_3 - (symbol->string - st_1))) - (string-append - pre_1 - app_3 - sep_1 - (symbol->string - '||) - post_1)))))))))))) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_3 + (symbol->string + st_0))) + (string-append + pre_0 + app_3 + sep_0 + (symbol->string + '||) + post_0))))))))))) (if (if can-impersonate?_0 can-impersonate?_0 system-opaque?_0) @@ -16781,27 +17094,21 @@ '((impersonator-val v))) '(#f))))))) - (let ((post_1 - post_0) - (sep_1 sep_0) - (st_1 st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_4 - (symbol->string - st_1))) - (string-append - pre_1 - app_4 - sep_1 - (symbol->string - '||) - post_1)))))))))))) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_4 + (symbol->string + st_0))) + (string-append + pre_0 + app_4 + sep_0 + (symbol->string + '||) + post_0))))))))))) (if system-opaque?_0 p_0 (list @@ -16996,29 +17303,21 @@ 'record-accessor struct:s_0 pos_0))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_5 + (symbol->string + st_0))) + (string-append + pre_0 + app_5 + sep_0 + (symbol->string + field-name_0) + post_0))))))))))) (if (if can-impersonate?_0 can-impersonate?_0 system-opaque?_0) @@ -17072,29 +17371,21 @@ (list 'quote field-name_0))))))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_5 + (symbol->string + st_0))) + (string-append + pre_0 + app_5 + sep_0 + (symbol->string + field-name_0) + post_0))))))))))) (if system-opaque?_0 p_0 (list @@ -17254,29 +17545,21 @@ 'record-mutator struct:s_0 pos_0))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_5 + (symbol->string + st_0))) + (string-append + pre_0 + app_5 + sep_0 + (symbol->string + field-name_0) + post_0))))))))))) (if (if can-impersonate?_0 can-impersonate?_0 system-opaque?_0) @@ -17289,13 +17572,11 @@ (let ((abs-pos_0 (+ pos_0 - (let ((app_5 - (struct-type-info-field-count - sti_0))) - (- - app_5 - (struct-type-info-immediate-field-count - sti_0)))))) + (- + (struct-type-info-field-count + sti_0) + (struct-type-info-immediate-field-count + sti_0))))) (if can-impersonate?_0 (list 'begin @@ -17344,29 +17625,21 @@ (list 'quote field-name_0))))))) - (let ((post_1 - post_0) - (sep_1 - sep_0) - (st_1 - st_0) - (pre_1 - pre_0)) - (begin-unsafe - (wrap-property-set - proc-expr_0 - 'inferred-name - (string->symbol - (let ((app_5 - (symbol->string - st_1))) - (string-append - pre_1 - app_5 - sep_1 - (symbol->string - field-name_0) - post_1)))))))))))) + (begin-unsafe + (wrap-property-set + proc-expr_0 + 'inferred-name + (string->symbol + (let ((app_5 + (symbol->string + st_0))) + (string-append + pre_0 + app_5 + sep_0 + (symbol->string + field-name_0) + post_0))))))))))) (if system-opaque?_0 p_0 (list @@ -17680,9 +17953,11 @@ args)))))) (case-lambda ((id_0 rhs_1 rest_0) - (cons - (list id_0 rhs_1) - (loop_0 rest_0))) + (let ((app_0 + (list id_0 rhs_1))) + (cons + app_0 + (loop_0 rest_0)))) (args (raise-binding-result-arity-error 3 @@ -17861,10 +18136,12 @@ args)))))) (case-lambda ((id_0 rhs_1 rest_0) - (list - 'let - (list (list id_0 rhs_1)) - (loop_0 rest_0))) + (let ((app_0 + (list (list id_0 rhs_1)))) + (list + 'let + app_0 + (loop_0 rest_0)))) (args (raise-binding-result-arity-error 3 @@ -18578,7 +18855,8 @@ knowns_1 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) (for-loop_2 rest_2)))) (values))))))) @@ -18592,7 +18870,8 @@ knowns_1 imports_0 mutated_0 - simples_0))) + simples_0 + unsafe-mode?_0))) (for-loop_1 rest_1 (+ @@ -18610,7 +18889,8 @@ knowns_1 imports_0 mutated_0 - simples_0)) + simples_0 + unsafe-mode?_0)) (begin (letrec* ((for-loop_1 @@ -18655,7 +18935,8 @@ knowns_1 imports_0 mutated_0 - simples_0))) + simples_0 + unsafe-mode?_0))) knowns_1)) (args (raise-binding-result-arity-error @@ -18755,7 +19036,14 @@ (void) mutated_0)))) (define find-mutated! - (lambda (top-v_0 ids_0 prim-knowns_0 knowns_0 imports_0 mutated_0 simples_0) + (lambda (top-v_0 + ids_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) (let ((delay!_0 (|#%name| delay! @@ -19604,18 +19892,20 @@ (if maybe-cc?_0 maybe-cc?_0 (not - (let ((temp23_0 + (let ((temp24_0 (length ids_2))) (simple?.1 #f - temp23_0 + #f + temp24_0 rhs_0 prim-knowns_0 knowns_0 imports_0 mutated_0 - simples_0)))))) + simples_0 + unsafe-mode?_0)))))) (begin (begin (letrec* @@ -20064,6 +20354,7 @@ (let ((result_1 (let ((result_1 (simple?.1 + #f #t 1 exp_0 @@ -20071,7 +20362,8 @@ knowns_0 imports_0 mutated_0 - simples_0))) + simples_0 + unsafe-mode?_0))) (values result_1)))) (if (if (not @@ -20256,7 +20548,8 @@ knowns_0 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) (if (null? ids_0) (if (null? (cdr bodys_0)) (car bodys_0) (list* 'begin bodys_0)) (if (null? (cdr ids_0)) @@ -20275,6 +20568,7 @@ (let ((rhs_0 (car rhss_1))) (if (if all-simple?_0 (simple?.1 + #f #t 1 rhs_0 @@ -20282,7 +20576,8 @@ knowns_0 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) #f) (list* 'let (list (list id_0 rhs_0)) bodys_0) (list @@ -20291,26 +20586,31 @@ (list* 'let binds_0 bodys_0))))) (let ((id_0 (car ids_1))) (let ((rhs_0 (car rhss_1))) - (list - 'let - (list (list id_0 rhs_0)) - (let ((app_0 (cdr ids_1))) - (let ((app_1 (cdr rhss_1))) - (loop_0 - app_0 - app_1 - (if all-simple?_0 - (simple?.1 - #t - 1 - rhs_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0) - #f) - (cons (list id_0 id_0) binds_0))))))))))))) + (let ((app_0 (list (list id_0 rhs_0)))) + (list + 'let + app_0 + (let ((app_1 (cdr ids_1))) + (let ((app_2 (cdr rhss_1))) + (let ((app_3 + (if all-simple?_0 + (simple?.1 + #f + #t + 1 + rhs_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) + #f))) + (loop_0 + app_1 + app_2 + app_3 + (cons (list id_0 id_0) binds_0))))))))))))))) (loop_0 ids_0 rhss_0 #t null)))))) (define left-to-right/let-values (lambda (idss_0 rhss_0 bodys_0 mutated_0 target_0) @@ -20327,11 +20627,12 @@ (begin (if (null? (cdr rhss_1)) (let ((app_0 (car idss_1))) - (make-let-values - app_0 - (car rhss_1) - (list* 'let binds_0 bodys_0) - target_0)) + (let ((app_1 (car rhss_1))) + (make-let-values + app_0 + app_1 + (list* 'let binds_0 bodys_0) + target_0))) (let ((ids_0 (car idss_1))) (let ((app_0 (car rhss_1))) (make-let-values @@ -20388,68 +20689,98 @@ knowns_0 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) (if (eq? target_0 'cify) (cons rator_0 rands_0) - (letrec* - ((loop_0 - (|#%name| - loop - (lambda (l_0 accum_0 pending-non-simple_0 pending-id_0) - (begin - (if (null? l_0) - (let ((app_0 - (if pending-non-simple_0 - (letrec* - ((loop_1 - (|#%name| - loop - (lambda (accum_1 rev-accum_0) - (begin - (if (null? accum_1) - rev-accum_0 - (if (eq? (car accum_1) pending-id_0) - (loop_1 - (cdr accum_1) - (cons pending-non-simple_0 rev-accum_0)) - (let ((app_0 (cdr accum_1))) - (loop_1 - app_0 - (cons - (car accum_1) - rev-accum_0)))))))))) - (loop_1 accum_0 null)) - (reverse$1 accum_0)))) - (if app-form_0 (cons app-form_0 app_0) app_0)) - (if (let ((temp13_0 (car l_0))) - (simple?.1 - #t - 1 - temp13_0 - prim-knowns_0 - knowns_0 - imports_0 - mutated_0 - simples_0)) - (let ((app_0 (cdr l_0))) - (loop_0 - app_0 - (cons (car l_0) accum_0) - pending-non-simple_0 - pending-id_0)) - (if pending-non-simple_0 - (list - 'let - (list (list pending-id_0 pending-non-simple_0)) - (loop_0 l_0 accum_0 #f #f)) - (let ((g_0 (deterministic-gensym "app_"))) - (let ((app_0 (cdr l_0))) - (loop_0 - app_0 - (cons g_0 accum_0) - (car l_0) - g_0))))))))))) - (loop_0 (cons rator_0 rands_0) null #f #f))))) + (let ((l_0 (cons rator_0 rands_0))) + (let ((modes_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1) + (begin + (if (null? l_1) + 'pure + (let ((modes_0 (loop_0 (cdr l_1)))) + (if (let ((temp15_0 (car l_1))) + (simple?.1 + #t + #t + 1 + temp15_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0)) + (if (symbol? modes_0) + modes_0 + (cons 'pure modes_0)) + (if (let ((temp23_0 (car l_1))) + (simple?.1 + #f + #t + 1 + temp23_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0)) + (if (symbol? modes_0) + 'alloc + (cons 'bind modes_0)) + (if (eq? modes_0 'pure) + (cons 'non-simple modes_0) + (cons 'bind modes_0))))))))))) + (loop_0 l_0)))) + (let ((no-bind-needed?_0 + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (modes_1) + (begin + (if (symbol? modes_1) + #t + (if (eq? (car modes_1) 'pure) + (loop_0 (cdr modes_1)) + (if (eq? (car modes_1) 'non-simple) #t #f)))))))) + (loop_0 modes_0)))) + (if no-bind-needed?_0 + (if app-form_0 (cons app-form_0 l_0) l_0) + (letrec* + ((loop_0 + (|#%name| + loop + (lambda (l_1 modes_1 accum_0) + (begin + (if (let ((or-part_0 (symbol? modes_1))) + (if or-part_0 + or-part_0 + (eq? (car modes_1) 'non-simple))) + (let ((app_0 (append (reverse$1 accum_0) l_1))) + (if app-form_0 (cons app-form_0 app_0) app_0)) + (if (eq? (car modes_1) 'bind) + (let ((g_0 (deterministic-gensym "app_"))) + (let ((app_0 (list (list g_0 (car l_1))))) + (list + 'let + app_0 + (let ((app_1 (cdr l_1))) + (let ((app_2 (cdr modes_1))) + (loop_0 app_1 app_2 (cons g_0 accum_0))))))) + (let ((app_0 (cdr l_1))) + (let ((app_1 (cdr modes_1))) + (loop_0 + app_0 + app_1 + (cons (car l_1) accum_0))))))))))) + (loop_0 l_0 modes_0 null))))))))) (define make-let-values (lambda (ids_0 rhs_0 body_0 target_0) (if (if (pair? ids_0) (null? (cdr ids_0)) #f) @@ -20495,22 +20826,26 @@ 'call-with-values (list 'lambda '() rhs_0) (list 'lambda ids_0 body_0)) - (list - 'call-with-values - (list 'lambda '() rhs_0) - (list - 'case-lambda - (list ids_0 body_0) + (let ((app_0 (list 'lambda '() rhs_0))) (list - 'args - (let ((app_0 - (if (eq? target_0 'system) '() '(|#%app/no-return|)))) - (qq-append - app_0 - (list* - 'raise-binding-result-arity-error - (length ids_0) - '(args)))))))))))))) + 'call-with-values + app_0 + (let ((app_1 (list ids_0 body_0))) + (list + 'case-lambda + app_1 + (list + 'args + (let ((app_2 + (if (eq? target_0 'system) + '() + '(|#%app/no-return|)))) + (qq-append + app_2 + (list* + 'raise-binding-result-arity-error + (length ids_0) + '(args)))))))))))))))) (define equal-implies-eq? (lambda (e_0) (let ((hd_0 @@ -20568,7 +20903,13 @@ (if or-part_0 or-part_0 (char? val_1))))) (let ((val_0 (unwrap e_0))) (number? val_0)))))) (define unnest-let - (lambda (e_0 prim-knowns_0 knowns_0 imports_0 mutated_0 simples_0) + (lambda (e_0 + prim-knowns_0 + knowns_0 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) (if (let ((p_0 (unwrap e_0))) (if (pair? p_0) (let ((a_0 (cdr p_0))) @@ -20957,6 +21298,7 @@ (immediate-lambda? rhs_0))) (simple?.1 + #f #t 1 rhs_0 @@ -20964,7 +21306,8 @@ knowns_0 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) #f))) (values result_1)))) @@ -21038,23 +21381,25 @@ (car (unwrap d_1)))) a_1)))))) (if (eq? 'let let-id_0) - (loop_0 - (cdr binds_1) - (cons - (list id_0 body_1) - accum-binds_0) - (cons - (cons nest-let-id_0 inner-binds_0) - wraps_0) - #t) (let ((app_0 (cdr binds_1))) (loop_0 app_0 (cons (list id_0 body_1) - (append - inner-binds_0 - accum-binds_0)) + accum-binds_0) + (cons + (cons nest-let-id_0 inner-binds_0) + wraps_0) + #t)) + (let ((app_0 (cdr binds_1))) + (loop_0 + app_0 + (let ((app_1 (list id_0 body_1))) + (cons + app_1 + (append + inner-binds_0 + accum-binds_0))) wraps_0 #t)))) (error 'match "failed ~e" v_1))) @@ -21633,10 +21978,8 @@ (with-continuation-mark* authentic parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) + (let ((app_0 (continuation-mark-set-first #f parameterization-key))) + (extend-parameterization app_0 gensym-counter (box 0))) (let ((im-int-id_0 (|#%name| im-int-id @@ -21902,10 +22245,10 @@ (let ((rest_0 (unsafe-cdr lst_0))) - (let ((fold-var_1 - (let ((lst_1 - (import-group-imports - grp_0))) + (let ((lst_1 + (import-group-imports + grp_0))) + (let ((fold-var_1 (begin (letrec* ((for-loop_1 @@ -21923,23 +22266,23 @@ (unsafe-cdr lst_2))) (let ((fold-var_2 - (let ((fold-var_2 - (cons - (import-id - im_0) - fold-var_1))) + (cons + (import-id + im_0) + fold-var_1))) + (let ((fold-var_3 (values - fold-var_2)))) - (for-loop_1 - fold-var_2 - rest_1)))) + fold-var_2))) + (for-loop_1 + fold-var_3 + rest_1))))) fold-var_1)))))) (for-loop_1 fold-var_0 - lst_1)))))) - (for-loop_0 - fold-var_1 - rest_0)))) + lst_1))))) + (for-loop_0 + fold-var_1 + rest_0))))) fold-var_0)))))) (for-loop_0 null @@ -22021,16 +22364,16 @@ (unsafe-cdr lst_2))) (let ((fold-var_2 - (let ((fold-var_2 - (cons - (import-ext-id - im_0) - fold-var_1))) + (cons + (import-ext-id + im_0) + fold-var_1))) + (let ((fold-var_3 (values - fold-var_2)))) - (for-loop_1 - fold-var_2 - rest_1)))) + fold-var_2))) + (for-loop_1 + fold-var_3 + rest_1))))) fold-var_1)))))) (for-loop_1 null @@ -22321,10 +22664,8 @@ (with-continuation-mark* authentic parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) + (let ((app_0 (continuation-mark-set-first #f parameterization-key))) + (extend-parameterization app_0 gensym-counter (box 0))) (call-with-values (lambda () (schemify-body* @@ -22435,20 +22776,20 @@ (case-lambda ((int-id_0 ex_0) (let ((fold-var_1 - (let ((fold-var_1 - (cons - (list* - 'define - (export-id ex_0) - '((make-internal-variable - 'int-id))) - fold-var_0))) - (values fold-var_1)))) - (for-loop_0 - fold-var_1 - (hash-iterate-next - extra-variables_0 - i_0)))) + (cons + (list* + 'define + (export-id ex_0) + '((make-internal-variable + 'int-id))) + fold-var_0))) + (let ((fold-var_2 + (values fold-var_1))) + (for-loop_0 + fold-var_2 + (hash-iterate-next + extra-variables_0 + i_0))))) (args (raise-binding-result-arity-error 2 @@ -22554,12 +22895,14 @@ u-id_0 knowns_1 mutated_0)) - (loop_1 - (cdr - accum-ids_1) - (cons - id_0 - consistent-ids_0)) + (let ((app_0 + (cdr + accum-ids_1))) + (loop_1 + app_0 + (cons + id_0 + consistent-ids_0))) (let ((app_0 (make-set-consistent-variables consistent-ids_0 @@ -22985,147 +23328,151 @@ (reverse$1 ids_0) knowns_1)))) - (let ((expr_0 - (let ((app_2 - (list - 'quote - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (variable-constance - (unwrap - id_0) - knowns_1 - mutated_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - ids_0))))))) - (list* - 'call-with-module-prompt - (list - 'lambda - '() - rhs_0) - (list - 'quote - ids_0) - app_2 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr - lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (id-to-variable - (unwrap - id_0) - exports_0 - knowns_1 - mutated_0 - extra-variables_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - ids_0)))))))) - (let ((defns_0 - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0) - (begin - (if (pair? - lst_0) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr + (let ((app_2 + (list + 'lambda + '() + rhs_0))) + (let ((expr_0 + (let ((app_3 + (list + 'quote + ids_0))) + (let ((app_4 + (list + 'quote + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (variable-constance + (unwrap + id_0) + knowns_1 + mutated_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0))))))) + (list* + 'call-with-module-prompt + app_2 + app_3 + app_4 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car + lst_0))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (id-to-variable + (unwrap + id_0) + exports_0 + knowns_1 + mutated_0 + extra-variables_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0))))))))) + (let ((defns_0 + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0) + (begin + (if (pair? + lst_0) + (let ((id_0 + (unsafe-car lst_0))) - (let ((fold-var_1 - (let ((fold-var_1 - (cons - (make-define-variable - id_0 - exports_0 - knowns_1 - mutated_0 - extra-variables_0) - fold-var_0))) - (values - fold-var_1)))) - (for-loop_0 - fold-var_1 - rest_0)))) - fold-var_0)))))) - (for-loop_0 - null - ids_0)))))) - (let ((app_2 - (if (eq? - target_0 - 'interp) - expr_0 - (make-expr-defn - expr_0)))) - (cons - app_2 - (append - defns_0 - (loop_0 - (cdr - l_1) - mut-l_0 - null - null - knowns_1))))))))))))))) + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((fold-var_1 + (let ((fold-var_1 + (cons + (make-define-variable + id_0 + exports_0 + knowns_1 + mutated_0 + extra-variables_0) + fold-var_0))) + (values + fold-var_1)))) + (for-loop_0 + fold-var_1 + rest_0)))) + fold-var_0)))))) + (for-loop_0 + null + ids_0)))))) + (let ((app_3 + (if (eq? + target_0 + 'interp) + expr_0 + (make-expr-defn + expr_0)))) + (cons + app_3 + (append + defns_0 + (loop_0 + (cdr + l_1) + mut-l_0 + null + null + knowns_1)))))))))))))))) (let ((hd_0 (let ((p_0 (unwrap @@ -23192,6 +23539,7 @@ (case-lambda ((id_0 rhs_0) (if (simple?.1 + #f #f 1 rhs_0 @@ -23199,14 +23547,15 @@ knowns_1 imports_0 mutated_0 - simples_0) - (let ((temp44_0 + simples_0 + unsafe-mode?_0) + (let ((temp45_0 (list id_0))) (finish-definition_0 unsafe-undefined #f unsafe-undefined - temp44_0 + temp45_0 unsafe-undefined unsafe-undefined)) (finish-wrapped-definition_0 @@ -23278,18 +23627,20 @@ rhs_0))))))) (case-lambda ((ids_0 rhs_0) - (if (let ((temp52_0 + (if (let ((temp54_0 (length ids_0))) (simple?.1 #f - temp52_0 + #f + temp54_0 rhs_0 prim-knowns_0 knowns_1 imports_0 mutated_0 - simples_0)) + simples_0 + unsafe-mode?_0)) (let ((hd_1 (let ((p_0 (unwrap @@ -23343,6 +23694,7 @@ (let ((result_1 (let ((result_1 (simple?.1 + #f #t 1 rhs_1 @@ -23350,7 +23702,8 @@ knowns_1 imports_0 mutated_0 - simples_0))) + simples_0 + unsafe-mode?_0))) (values result_1)))) (if (if (not @@ -23395,15 +23748,15 @@ (let ((rhs_1 (car rhss_1))) - (let ((temp59_0 + (let ((temp62_0 (list id_0))) - (let ((temp63_0 + (let ((temp66_0 (list 'define id_0 rhs_1))) - (let ((temp64_0 + (let ((temp67_0 (lambda (accum-exprs_2 accum-ids_2 knowns_3) @@ -23419,9 +23772,9 @@ knowns_3))))) (finish-definition_0 knowns_2 - temp64_0 - temp63_0 - temp59_0 + temp67_0 + temp66_0 + temp62_0 accum-exprs_1 accum-ids_1)))))))))))) (values-loop_0 @@ -23544,7 +23897,7 @@ a_0)))) (let ((set-vars_0 (make-set-variables_0))) - (let ((temp68_0 + (let ((temp71_0 (append set-vars_0 accum-exprs_0))) @@ -23553,9 +23906,10 @@ #f unsafe-undefined ids_0 - temp68_0 + temp71_0 null)))) (if (simple?.1 + #f #f #f schemified_0 @@ -23563,15 +23917,18 @@ knowns_1 imports_0 mutated_0 - simples_0) - (loop_0 - (cdr l_1) - mut-l_0 - (cons - schemified_0 - accum-exprs_0) - accum-ids_0 - knowns_1) + simples_0 + unsafe-mode?_0) + (let ((app_0 + (cdr l_1))) + (loop_0 + app_0 + mut-l_0 + (cons + schemified_0 + accum-exprs_0) + accum-ids_0 + knowns_1)) (let ((set-vars_0 (make-set-variables_0))) (let ((expr_0 @@ -23692,10 +24049,8 @@ (list 'define id_0 (list 'variable-ref/no-check (export-id ex_0))))))) (define make-expr-defn (lambda (expr_0) - (list - 'define - (deterministic-gensym "effect") - (list* 'begin expr_0 '((void)))))) + (let ((app_0 (deterministic-gensym "effect"))) + (list 'define app_0 (list* 'begin expr_0 '((void))))))) (define variable-constance (lambda (id_0 knowns_0 mutated_0) (if (set!ed-mutated-state? (hash-ref mutated_0 id_0 #f)) @@ -23891,14 +24246,14 @@ formalss_2 bodys_1)))))) (case-lambda - ((formalss78_0 - bodys79_0) + ((formalss82_0 + bodys83_0) (values (cons - formalss78_0 + formalss82_0 formalss_0) (cons - bodys79_0 + bodys83_0 bodys_0))) (args (raise-binding-result-arity-error @@ -25163,14 +25518,14 @@ ids_2 rhss_1)))))) (case-lambda - ((ids80_0 - rhss81_0) + ((ids84_0 + rhss85_0) (values (cons - ids80_0 + ids84_0 ids_0) (cons - rhss81_0 + rhss85_0 rhss_0))) (args (raise-binding-result-arity-error @@ -25254,12 +25609,12 @@ (unwrap (car bodys_0)))) - (let ((temp82_0 + (let ((temp86_0 (car rhss_0))) (lambda?.1 #f - temp82_0)) + temp86_0)) #f) #f) #f) @@ -25483,12 +25838,14 @@ knowns_1 imports_0 mutated_0 - simples_0))) + simples_0 + unsafe-mode?_0))) prim-knowns_0 knowns_1 imports_0 mutated_0 - simples_0))))) + simples_0 + unsafe-mode?_0))))) (args (raise-binding-result-arity-error 3 @@ -25910,14 +26267,14 @@ idss_2 rhss_1)))))) (case-lambda - ((idss93_0 - rhss94_0) + ((idss97_0 + rhss98_0) (values (cons - idss93_0 + idss97_0 idss_0) (cons - rhss94_0 + rhss98_0 rhss_0))) (args (raise-binding-result-arity-error @@ -25998,9 +26355,9 @@ (eq? target_0 'cify)))) - (let ((temp101_0 + (let ((temp105_0 (|#%name| - temp101 + temp105 (lambda (v_3 knowns_2) (begin @@ -26019,7 +26376,7 @@ imports_0 mutated_0 simples_0 - temp101_0)) + temp105_0)) #f))) (if or-part_0 or-part_0 @@ -26070,7 +26427,8 @@ knowns_1 imports_0 mutated_0 - simples_0)))) + simples_0 + unsafe-mode?_0)))) (args (raise-binding-result-arity-error 3 @@ -26677,14 +27035,14 @@ ids_2 rhss_1)))))) (case-lambda - ((ids104_0 - rhss105_0) + ((ids108_0 + rhss109_0) (values (cons - ids104_0 + ids108_0 ids_0) (cons - rhss105_0 + rhss109_0 rhss_0))) (args (raise-binding-result-arity-error @@ -26966,7 +27324,8 @@ knowns_1 imports_0 mutated_0 - simples_0)) + simples_0 + unsafe-mode?_0)) (args (raise-binding-result-arity-error 2 @@ -27155,14 +27514,14 @@ idss_2 rhss_1)))))) (case-lambda - ((idss116_0 - rhss117_0) + ((idss120_0 + rhss121_0) (values (cons - idss116_0 + idss120_0 idss_0) (cons - rhss117_0 + rhss121_0 rhss_0))) (args (raise-binding-result-arity-error @@ -27235,9 +27594,9 @@ ((idss_0 rhss_0 bodys_0) - (let ((temp125_0 + (let ((temp129_0 (|#%name| - temp125 + temp129 (lambda (v_3 knowns_2) (begin @@ -27257,7 +27616,7 @@ imports_0 mutated_0 simples_0 - temp125_0))) + temp129_0))) (if c1_0 c1_0 (if (letrec-splitable-values-binding? @@ -27656,6 +28015,7 @@ mutated_0))) (if (if authentic-key?_0 (simple?.1 + #f #t #f s-body_0 @@ -27663,7 +28023,8 @@ knowns_1 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) #f) (let ((app_0 (ensure-single-valued @@ -27997,24 +28358,28 @@ (let ((tmp_0 (deterministic-gensym "set"))) - (list - 'let - (list - (list - tmp_0 - new-rhs_0)) - (list - 'check-not-unsafe-undefined/assign - id_0 - (list - 'quote - (too-early-mutated-state-name - state_0 - int-id_0))) - (list - 'set! - id_0 - tmp_0))) + (let ((app_0 + (list + (list + tmp_0 + new-rhs_0)))) + (let ((app_1 + (list + 'check-not-unsafe-undefined/assign + id_0 + (list + 'quote + (too-early-mutated-state-name + state_0 + int-id_0))))) + (list + 'let + app_0 + app_1 + (list + 'set! + id_0 + tmp_0))))) (if (not state_0) (list @@ -28409,7 +28774,8 @@ knowns_1 imports_0 mutated_0 - simples_0)))))))) + simples_0 + unsafe-mode?_0)))))))) (args (raise-binding-result-arity-error 2 @@ -28526,7 +28892,8 @@ knowns_1 imports_0 mutated_0 - simples_0)))) + simples_0 + unsafe-mode?_0)))) (args (raise-binding-result-arity-error 2 @@ -28816,15 +29183,17 @@ '() '() (cons - (list - (list - formal-args_1) - (if (null? - args_0) - ''() - (cons - 'list - args_0))) + (let ((app_0 + (list + formal-args_1))) + (list + app_0 + (if (null? + args_0) + ''() + (cons + 'list + args_0)))) binds_0)) (let ((app_0 (cdr @@ -29071,7 +29440,8 @@ knowns_1 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) #f))))))) (let ((inline-struct-predicate_0 (|#%name| @@ -29322,7 +29692,8 @@ knowns_1 imports_0 mutated_0 - simples_0)) + simples_0 + unsafe-mode?_0)) (let ((c5_0 (if (not (let ((or-part_2 @@ -29425,7 +29796,8 @@ knowns_1 imports_0 mutated_0 - simples_0) + simples_0 + unsafe-mode?_0) (left-to-right/app s-rator_1 args_1 @@ -29457,7 +29829,8 @@ knowns_1 imports_0 mutated_0 - simples_0))))))))))))) + simples_0 + unsafe-mode?_0))))))))))))) (args (raise-binding-result-arity-error 2 @@ -31387,16 +31760,18 @@ ((new-body_0 lam-body-free_0 new-body-lifts_0) - (values - (cons - new-body_0 - rev-new-bodys_0) - (union-free_0 - (remove-args_0 - lam-body-free_0 - args_0) - lam-free_0) - new-body-lifts_0)) + (let ((app_0 + (cons + new-body_0 + rev-new-bodys_0))) + (values + app_0 + (union-free_0 + (remove-args_0 + lam-body-free_0 + args_0) + lam-free_0) + new-body-lifts_0))) (args (raise-binding-result-arity-error 3 @@ -34703,13 +35078,11 @@ (begin (if (convert-mode? cm_0) (if (convert-mode? cm_0) - (let ((app_0 (convert-mode-sizes cm_0))) - (let ((app_1 (convert-mode-lift? cm_0))) - (convert-mode1.1 - app_0 - #f - app_1 - (convert-mode-no-more-conversions? cm_0)))) + (convert-mode1.1 + (convert-mode-sizes cm_0) + #f + (convert-mode-lift? cm_0) + (convert-mode-no-more-conversions? cm_0)) (raise-argument-error 'struct-copy "convert-mode?" cm_0)) (if (eq? 'no-lift (cdr cm_0)) '(not-called . no-lift) @@ -34721,13 +35094,11 @@ (begin (if (convert-mode? cm_0) (if (convert-mode? cm_0) - (let ((app_0 (convert-mode-sizes cm_0))) - (let ((app_1 (convert-mode-lift? cm_0))) - (convert-mode1.1 - app_0 - #t - app_1 - (convert-mode-no-more-conversions? cm_0)))) + (convert-mode1.1 + (convert-mode-sizes cm_0) + #t + (convert-mode-lift? cm_0) + (convert-mode-no-more-conversions? cm_0)) (raise-argument-error 'struct-copy "convert-mode?" cm_0)) (if (eq? 'no-lift (cdr cm_0)) '(called . no-lift) @@ -35356,10 +35727,8 @@ (with-continuation-mark* authentic parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) + (let ((app_0 (continuation-mark-set-first #f parameterization-key))) + (extend-parameterization app_0 gensym-counter (box 0))) (top_0))))) (define xify (lambda (e_0) @@ -38846,8 +39215,7 @@ (to-unfasl-wrt v_0))) (let ((temp7_0 (to-unfasl-bstr v_0))) (let ((temp10_0 (to-unfasl-externals v_0))) - (let ((temp7_1 temp7_0)) - (fasl->s-exp.1 #t temp10_0 #t temp7_1))))))) + (fasl->s-exp.1 #t temp10_0 #t temp7_0)))))) (letrec* ((loop_0 (|#%name| @@ -38913,8 +39281,11 @@ (let ((new-to_0 (insert (node-left t_0) key_0 val_0))) (let ((new-other_0 (node-right t_0))) (let ((new-t_0 - (let ((app_0 (node-key t_0))) - (combine app_0 (node-val t_0) new-to_0 new-other_0)))) + (combine + (node-key t_0) + (node-val t_0) + new-to_0 + new-other_0))) (let ((to-height_0 (tree-height new-to_0))) (let ((other-height_0 (tree-height new-other_0))) (if (fx= (fx- to-height_0 other-height_0) 2) @@ -38923,20 +39294,22 @@ (if (fx< (node-key t_0) key_0) (let ((new-to_0 (insert (node-right t_0) key_0 val_0))) (let ((new-other_0 (node-left t_0))) - (let ((new-t_0 - (let ((key_1 (node-key t_0))) + (let ((key_1 (node-key t_0))) + (let ((new-t_0 (let ((val_1 (node-val t_0))) - (let ((key_2 key_1)) - (begin-unsafe - (combine key_2 val_1 new-other_0 new-to_0))))))) - (let ((to-height_0 (tree-height new-to_0))) - (let ((other-height_0 (tree-height new-other_0))) - (if (fx= (fx- to-height_0 other-height_0) 2) - (rotate-left new-t_0) - new-t_0)))))) - (let ((app_0 (node-height t_0))) - (let ((app_1 (node-left t_0))) - (node1.1 key_0 val_0 app_0 app_1 (node-right t_0))))))))) + (begin-unsafe + (combine key_1 val_1 new-other_0 new-to_0))))) + (let ((to-height_0 (tree-height new-to_0))) + (let ((other-height_0 (tree-height new-other_0))) + (if (fx= (fx- to-height_0 other-height_0) 2) + (rotate-left new-t_0) + new-t_0))))))) + (node1.1 + key_0 + val_0 + (node-height t_0) + (node-left t_0) + (node-right t_0))))))) (define delete (lambda (t_0 key_0) (if (not t_0) @@ -38945,8 +39318,11 @@ (let ((new-to_0 (delete (node-left t_0) key_0))) (let ((new-other_0 (node-right t_0))) (let ((new-t_0 - (let ((app_0 (node-key t_0))) - (combine app_0 (node-val t_0) new-to_0 new-other_0)))) + (combine + (node-key t_0) + (node-val t_0) + new-to_0 + new-other_0))) (let ((to-height_0 (tree-height new-to_0))) (let ((other-height_0 (tree-height new-other_0))) (if (fx= (fx- to-height_0 other-height_0) -2) @@ -38955,17 +39331,16 @@ (if (fx< (node-key t_0) key_0) (let ((new-to_0 (delete (node-right t_0) key_0))) (let ((new-other_0 (node-left t_0))) - (let ((new-t_0 - (let ((key_1 (node-key t_0))) + (let ((key_1 (node-key t_0))) + (let ((new-t_0 (let ((val_0 (node-val t_0))) - (let ((key_2 key_1)) - (begin-unsafe - (combine key_2 val_0 new-other_0 new-to_0))))))) - (let ((to-height_0 (tree-height new-to_0))) - (let ((other-height_0 (tree-height new-other_0))) - (if (fx= (fx- to-height_0 other-height_0) -2) - (rotate-right new-t_0) - new-t_0)))))) + (begin-unsafe + (combine key_1 val_0 new-other_0 new-to_0))))) + (let ((to-height_0 (tree-height new-to_0))) + (let ((other-height_0 (tree-height new-other_0))) + (if (fx= (fx- to-height_0 other-height_0) -2) + (rotate-right new-t_0) + new-t_0))))))) (let ((l_0 (node-left t_0))) (let ((r_0 (node-right t_0))) (if (not l_0) @@ -38986,12 +39361,11 @@ (let ((key_1 (node-key end_0))) (let ((new-from_0 (delete from_0 key_1))) - (let ((app_0 (node-val end_0))) - (combine - key_1 - app_0 - new-from_0 - (node-right t_0)))))))))))) + (combine + key_1 + (node-val end_0) + new-from_0 + (node-right t_0))))))))))) (loop_0 from_0)))) (let ((from-height_0 (tree-height (node-left new-t_0)))) (let ((other-height_0 @@ -39030,8 +39404,11 @@ (combine app_2 app_3 - (let ((app_4 (node-key orange_0))) - (combine app_4 (node-val orange_0) A_0 B_0)) + (combine + (node-key orange_0) + (node-val orange_0) + A_0 + B_0) C_0))) D_0)))))))))))))) (define single-rotate.1 @@ -39047,10 +39424,11 @@ app_0 app_1 app_2 - (let ((app_3 (node-key t_0))) - (let ((app_4 (node-val t_0))) - (let ((app_5 (node-right yellow_0))) - (combine app_3 app_4 app_5 (node-right t_0)))))))))))))) + (combine + (node-key t_0) + (node-val t_0) + (node-right yellow_0) + (node-right t_0))))))))))) (define rotate-left (lambda (t_0) (let ((to_0 (node-right t_0))) @@ -39080,13 +39458,12 @@ (let ((right_0 (let ((key_2 (node-key orange_0))) (let ((val_2 (node-val orange_0))) - (let ((key_3 key_2)) - (begin-unsafe - (combine - key_3 - val_2 - B_0 - A_0))))))) + (begin-unsafe + (combine + key_2 + val_2 + B_0 + A_0)))))) (let ((val_2 val_1) (key_2 key_1)) (begin-unsafe (combine @@ -39111,11 +39488,8 @@ (let ((val_1 (node-val t_0))) (let ((right_1 (node-left yellow_0))) (let ((left_0 (node-left t_0))) - (let ((right_2 right_1) - (val_2 val_1) - (key_2 key_1)) - (begin-unsafe - (combine key_2 val_2 left_0 right_2))))))))) + (begin-unsafe + (combine key_1 val_1 left_0 right_1)))))))) (let ((right_1 right_0) (val_1 val_0) (key_1 key_0)) (begin-unsafe (combine key_1 val_1 left_0 right_1)))))))))))) @@ -39415,15 +39789,12 @@ pos_0))))))))))))) (define stack-info-branch (lambda (stk-i_0) - (let ((app_0 (stack-info-capture-depth stk-i_0))) - (let ((app_1 (stack-info-closure-map stk-i_0))) - (let ((app_2 (stack-info-use-map stk-i_0))) - (stack-info4.1 - app_0 - app_1 - app_2 - hash2610 - (stack-info-non-tail-call-later? stk-i_0))))))) + (stack-info4.1 + (stack-info-capture-depth stk-i_0) + (stack-info-closure-map stk-i_0) + (stack-info-use-map stk-i_0) + hash2610 + (stack-info-non-tail-call-later? stk-i_0)))) (define stack-info-branch-need-clears? (lambda (stk-i_0) (stack-info-non-tail-call-later? stk-i_0))) (define stack-info-merge! @@ -40883,16 +41254,18 @@ rhss2_0) (pos2_1 pos2_0)) - (vector - 'let* - (list - pos_0 - pos2_1) - (list - (list->vector - new-rhss_0) - rhss2_1) - b_0))))) + (let ((app_0 + (list + pos_0 + pos2_1))) + (vector + 'let* + app_0 + (list + (list->vector + new-rhss_0) + rhss2_1) + b_0)))))) (if (if (eq? 'let* (unsafe-vector*-ref @@ -40916,16 +41289,18 @@ rhsss_0) (poss_1 poss_0)) - (vector - 'let* - (cons - pos_0 - poss_1) - (cons - (list->vector - new-rhss_0) - rhsss_1) - b_0))))) + (let ((app_0 + (cons + pos_0 + poss_1))) + (vector + 'let* + app_0 + (cons + (list->vector + new-rhss_0) + rhsss_1) + b_0)))))) (if (if (eq? 'clear (unsafe-vector*-ref @@ -41585,60 +41960,65 @@ null ids_0)))))) (compile-expr_0 - (list - 'call-with-values - (list 'lambda '() rhs_0) - (list* - 'lambda - gen-ids_0 - (if (null? ids_0) - (list (void)) - (reverse$1 - (begin - (letrec* - ((for-loop_0 - (|#%name| - for-loop - (lambda (fold-var_0 - lst_0 - lst_1) - (begin - (if (if (pair? - lst_0) - (pair? + (let ((app_0 + (list + 'lambda + '() + rhs_0))) + (list + 'call-with-values + app_0 + (list* + 'lambda + gen-ids_0 + (if (null? ids_0) + (list (void)) + (reverse$1 + (begin + (letrec* + ((for-loop_0 + (|#%name| + for-loop + (lambda (fold-var_0 + lst_0 lst_1) - #f) - (let ((id_0 - (unsafe-car - lst_0))) - (let ((rest_0 - (unsafe-cdr + (begin + (if (if (pair? + lst_0) + (pair? + lst_1) + #f) + (let ((id_0 + (unsafe-car lst_0))) - (let ((gen-id_0 - (unsafe-car - lst_1))) - (let ((rest_1 - (unsafe-cdr + (let ((rest_0 + (unsafe-cdr + lst_0))) + (let ((gen-id_0 + (unsafe-car lst_1))) - (let ((fold-var_1 - (cons - (list - 'set! - id_0 - gen-id_0) - fold-var_0))) - (let ((fold-var_2 - (values - fold-var_1))) - (for-loop_0 - fold-var_2 - rest_0 - rest_1))))))) - fold-var_0)))))) - (for-loop_0 - null - ids_0 - gen-ids_0))))))) + (let ((rest_1 + (unsafe-cdr + lst_1))) + (let ((fold-var_1 + (cons + (list + 'set! + id_0 + gen-id_0) + fold-var_0))) + (let ((fold-var_2 + (values + fold-var_1))) + (for-loop_0 + fold-var_2 + rest_0 + rest_1))))))) + fold-var_0)))))) + (for-loop_0 + null + ids_0 + gen-ids_0)))))))) env_0 stack-depth_0 stk-i_0 @@ -43236,39 +43616,39 @@ u_0))) (if (indirect? var_0) - (let ((pos_0 - (let ((temp36_0 - (indirect-pos - var_0))) + (let ((temp36_0 + (indirect-pos + var_0))) + (let ((pos_0 (stack->pos.1 #f temp36_0 - stk-i_0)))) - (let ((elem_0 - (indirect-element - var_0))) - (cons - pos_0 - elem_0))) + stk-i_0))) + (let ((elem_0 + (indirect-element + var_0))) + (cons + pos_0 + elem_0)))) (if (boxed? var_0) - (let ((pos_0 - (let ((temp38_0 - (boxed-pos - var_0))) + (let ((temp38_0 + (boxed-pos + var_0))) + (let ((pos_0 (stack->pos.1 #f temp38_0 - stk-i_0)))) - (if (boxed/check? - var_0) - (vector - 'unbox/checked - pos_0 - u_0) - (vector - 'unbox - pos_0))) + stk-i_0))) + (if (boxed/check? + var_0) + (vector + 'unbox/checked + pos_0 + u_0) + (vector + 'unbox + pos_0)))) (stack->pos.1 #f var_0 @@ -43577,18 +43957,16 @@ (let ((u_0 (unwrap id_0))) (let ((var_0 (hash-ref env_0 u_0))) (if (indirect? var_0) - (let ((s_0 - (let ((temp47_0 (indirect-pos var_0))) - (stack->pos.1 #f temp47_0 stk-i_0)))) - (let ((e_0 (indirect-element var_0))) - (vector 'set!-indirect s_0 e_0 compiled-rhs_0))) + (let ((temp47_0 (indirect-pos var_0))) + (let ((s_0 (stack->pos.1 #f temp47_0 stk-i_0))) + (let ((e_0 (indirect-element var_0))) + (vector 'set!-indirect s_0 e_0 compiled-rhs_0)))) (if (boxed? var_0) - (let ((s_0 - (let ((temp49_0 (boxed-pos var_0))) - (stack->pos.1 #f temp49_0 stk-i_0)))) - (if (boxed/check? var_0) - (vector 'set!-boxed/checked s_0 compiled-rhs_0 u_0) - (vector 'set!-boxed s_0 compiled-rhs_0 u_0))) + (let ((temp49_0 (boxed-pos var_0))) + (let ((s_0 (stack->pos.1 #f temp49_0 stk-i_0))) + (if (boxed/check? var_0) + (vector 'set!-boxed/checked s_0 compiled-rhs_0 u_0) + (vector 'set!-boxed s_0 compiled-rhs_0 u_0)))) (error 'compile "unexpected set! ~s -> ~v" @@ -45268,10 +45646,8 @@ (with-continuation-mark* authentic parameterization-key - (extend-parameterization - (continuation-mark-set-first #f parameterization-key) - gensym-counter - (box 0)) + (let ((app_0 (continuation-mark-set-first #f parameterization-key))) + (extend-parameterization app_0 gensym-counter (box 0))) (start_0 linklet-e_0))))) (define interpret-linklet (lambda (b_0) @@ -45313,10 +45689,14 @@ (if (< pos_0 num-body-vars_1) (let ((stack_1 (let ((stack_1 - (stack-set - stack_0 - (+ pos_0 post-args-pos_0) - (box unsafe-undefined)))) + (let ((app_0 + (+ + pos_0 + post-args-pos_0))) + (stack-set + stack_0 + app_0 + (box unsafe-undefined))))) (values stack_1)))) (for-loop_0 stack_1 (+ pos_0 1))) stack_0)))))) @@ -47506,9 +47886,8 @@ (values rhss_1 body_0))))))) (case-lambda ((rhss_0 body_0) - (body-leftover-size_0 - (cons rhss_0 body_0) - (sub1 size_1))) + (let ((app_0 (cons rhss_0 body_0))) + (body-leftover-size_0 app_0 (sub1 size_1)))) (args (raise-binding-result-arity-error 2 args)))) (if (if (eq? 'letrec-values hd_0) (let ((a_0 (cdr (unwrap e_1)))) @@ -47660,9 +48039,8 @@ (values rhss_1 body_0))))))) (case-lambda ((rhss_0 body_0) - (body-leftover-size_0 - (cons rhss_0 body_0) - (sub1 size_1))) + (let ((app_0 (cons rhss_0 body_0))) + (body-leftover-size_0 app_0 (sub1 size_1)))) (args (raise-binding-result-arity-error 2 args)))) (if (if (eq? 'if hd_0) diff --git a/racket/src/cs/schemified/thread.scm b/racket/src/cs/schemified/thread.scm index 95c2624c4a..5b47dbf0f5 100644 --- a/racket/src/cs/schemified/thread.scm +++ b/racket/src/cs/schemified/thread.scm @@ -330,18 +330,20 @@ keyword-procedure? keyword-procedure-ref keyword-procedure-set!) - (make-struct-type - 'keyword-procedure - #f - 4 - 0 - #f - (list - (cons prop:checked-procedure #t) - (cons prop:impersonator-of keyword-procedure-impersonator-of)) - (current-inspector) - #f - '(0 1 2 3))) + (let ((app_0 + (list + (cons prop:checked-procedure #t) + (cons prop:impersonator-of keyword-procedure-impersonator-of)))) + (make-struct-type + 'keyword-procedure + #f + 4 + 0 + #f + app_0 + (current-inspector) + #f + '(0 1 2 3)))) (define keyword-procedure-required (make-struct-field-accessor keyword-procedure-ref 2)) (define keyword-procedure-allowed @@ -1088,12 +1090,10 @@ (lambda (q_0 n_0) (begin (if (node-prev$1 n_0) - (let ((app_0 (node-prev$1 n_0))) - (set-node-next!$1 app_0 (node-next$1 n_0))) + (set-node-next!$1 (node-prev$1 n_0) (node-next$1 n_0)) (set-queue-start! q_0 (node-next$1 n_0))) (if (node-next$1 n_0) - (let ((app_0 (node-next$1 n_0))) - (set-node-prev!$1 app_0 (node-prev$1 n_0))) + (set-node-prev!$1 (node-next$1 n_0) (node-prev$1 n_0)) (set-queue-end! q_0 (node-prev$1 n_0)))))) (define internal-error (lambda (s_0) @@ -1333,18 +1333,24 @@ (if (|#%app| syncers)) - (let ((app_2 - (choice-evt-evts - new-evt_0))) - (let ((app_3 - (syncer-wraps - sr_0))) - (let ((app_4 - (syncer-commits - sr_0))) - (|#%app| - app_1 - #f - app_2 - app_3 - app_4 - (syncer-abandons - sr_0)))))))))) + (|#%app| + app_1 + #f + (choice-evt-evts + new-evt_0) + (syncer-wraps sr_0) + (syncer-commits sr_0) + (syncer-abandons + sr_0))))))) (if (not new-syncers_0) (begin (syncer-remove! sr_0 s32_0) @@ -10302,17 +10294,17 @@ (let ((ns_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) (let ((result_1 - (let ((result_1 - (syncing-selected - ns_0))) - (values result_1)))) - (if (if (not - (let ((x_0 (list ns_0))) - result_1)) - #t - #f) - (for-loop_0 result_1 rest_0) - result_1)))) + (syncing-selected ns_0))) + (let ((result_2 + (values result_1))) + (if (if (not + (let ((x_0 + (list ns_0))) + result_2)) + #t + #f) + (for-loop_0 result_2 rest_0) + result_2))))) result_0)))))) (for-loop_0 #f nss_0))))) void @@ -10502,10 +10494,8 @@ (lambda () (let ((s_0 (let ((temp89_0 - (|#%app| - evts->syncers - 'replace-evt - (list evt_0)))) + (let ((app_0 evts->syncers)) + (|#%app| app_0 'replace-evt (list evt_0))))) (make-syncing.1 #f temp89_0)))) (values #f @@ -11314,7 +11304,7 @@ (if (let ((or-part_0 (not me-f_0))) (if or-part_0 or-part_0 (eq? me-f_0 f_0))) (lock-acquire (future*-lock f_0)) - (if (let ((app_0 (future*-id me-f_0))) (< app_0 (future*-id f_0))) + (if (< (future*-id me-f_0) (future*-id f_0)) (begin (lock-acquire (future*-lock me-f_0)) (lock-acquire (future*-lock f_0))) @@ -11449,8 +11439,7 @@ (if touching-f6_0 (let ((temp48_0 (future*-id me-f_0))) (let ((temp49_0 (future*-id touching-f6_0))) - (let ((temp48_1 temp48_0)) - (log-future.1 temp49_0 #f 'touch temp48_1)))) + (log-future.1 temp49_0 #f 'touch temp48_0))) (void)) (if (future*-would-be? me-f_0) (void) @@ -11686,12 +11675,10 @@ (if or-part_0 or-part_0 (future*-next f_0))) (begin (if (future*-prev f_0) - (let ((app_0 (future*-prev f_0))) - (set-future*-next! app_0 (future*-next f_0))) + (set-future*-next! (future*-prev f_0) (future*-next f_0)) (set-scheduler-futures-head! s_0 (future*-next f_0))) (if (future*-next f_0) - (let ((app_0 (future*-next f_0))) - (set-future*-prev! app_0 (future*-prev f_0))) + (set-future*-prev! (future*-next f_0) (future*-prev f_0)) (set-scheduler-futures-tail! s_0 (future*-prev f_0))) (set-future*-prev! f_0 #f) (set-future*-next! f_0 #f)) @@ -11784,11 +11771,10 @@ (scheduler-mutex s_0)) (loop_0)) (begin - (let ((app_0 (scheduler-cond s_0))) - (|#%app| - host:condition-wait - app_0 - (scheduler-mutex s_0))) + (|#%app| + host:condition-wait + (scheduler-cond s_0) + (scheduler-mutex s_0)) (loop_0))))))))))) (loop_0))))))) (set-worker-pthread! w_0 th_0))))) @@ -11930,11 +11916,10 @@ result_0)))))) (for-loop_0 #f lst_0)))) (begin - (let ((app_0 (scheduler-ping-cond s_0))) - (|#%app| - host:condition-wait - app_0 - (scheduler-mutex s_0))) + (|#%app| + host:condition-wait + (scheduler-ping-cond s_0) + (scheduler-mutex s_0)) (loop_0)) (void))))))) (loop_0)) @@ -12317,10 +12302,9 @@ (if (pair? lst_0) (let ((t_0 (unsafe-car lst_0))) (let ((rest_0 (unsafe-cdr lst_0))) - (let ((exts_1 - (let ((exts_1 - (let ((sched-info_0 - (thread-sched-info t_0))) + (let ((sched-info_0 (thread-sched-info t_0))) + (let ((exts_1 + (let ((exts_1 (let ((t-exts_0 (if sched-info_0 (schedule-info-exts @@ -12331,9 +12315,9 @@ (sandman-do-merge-external-event-sets the-sandman) exts_0 - t-exts_0)))))) - (values exts_1)))) - (for-loop_0 exts_1 rest_0)))) + t-exts_0))))) + (values exts_1)))) + (for-loop_0 exts_1 rest_0))))) exts_0)))))) (for-loop_0 sleeping-exts_0 ts_0))))) (begin @@ -13694,11 +13678,10 @@ (let ((temp12_0 (place-id new-place_0))) - (let ((temp11_1 temp11_0)) - (log-place.1 - unsafe-undefined - temp12_0 - temp11_1)))) + (log-place.1 + unsafe-undefined + temp12_0 + temp11_0))) (values new-place_0 parent-in_0 @@ -13914,8 +13897,7 @@ (end-atomic))) (let ((temp26_0 "reap")) (let ((temp27_0 (place-id p_0))) - (let ((temp26_1 temp26_0)) - (log-place.1 unsafe-undefined temp27_0 temp26_1)))) + (log-place.1 unsafe-undefined temp27_0 temp26_0))) (void)) (void)) (let ((cref_0 (place-custodian-ref p_0))) @@ -14099,13 +14081,8 @@ (record-mutator struct:message-queue 4))) (define make-message-queue (lambda () - (message-queue4.1 - (|#%app| host:make-mutex) - '() - '() - (box #f) - hash2725 - (box #f)))) + (let ((app_0 (|#%app| host:make-mutex))) + (message-queue4.1 app_0 '() '() (box #f) hash2725 (box #f))))) (define enqueue! (lambda (mq_0 msg_0 wk_0) (let ((lock_0 (message-queue-lock mq_0))) @@ -14371,25 +14348,21 @@ (let ((wk1_0 (gensym 'write))) (let ((rk2_0 (gensym 'read))) (let ((wk2_0 (gensym 'write))) - (let ((app_0 - (let ((app_0 (message-queue-out-key-box mq1_0))) - (pchannel5.1 - (make-ephemeron wk1_0 mq1_0) - (make-ephemeron rk2_0 mq2_0) - rk1_0 - wk2_0 - app_0 - (message-queue-in-key-box mq2_0))))) - (values - app_0 - (let ((app_1 (message-queue-out-key-box mq2_0))) - (pchannel5.1 - (make-ephemeron wk2_0 mq2_0) - (make-ephemeron rk1_0 mq1_0) - rk2_0 - wk1_0 - app_1 - (message-queue-in-key-box mq1_0))))))))))))))) + (values + (pchannel5.1 + (make-ephemeron wk1_0 mq1_0) + (make-ephemeron rk2_0 mq2_0) + rk1_0 + wk2_0 + (message-queue-out-key-box mq1_0) + (message-queue-in-key-box mq2_0)) + (pchannel5.1 + (make-ephemeron wk2_0 mq2_0) + (make-ephemeron rk1_0 mq1_0) + rk2_0 + wk1_0 + (message-queue-out-key-box mq2_0) + (message-queue-in-key-box mq1_0))))))))))))) (define 1/place-channel-get (|#%name| place-channel-get @@ -14658,18 +14631,18 @@ (lock-release (fsemaphore-lock fs_0)) (future-suspend) (void)) - (let ((dep-box_0 - (let ((or-part_0 (fsemaphore-dep-box fs_0))) + (let ((or-part_0 (fsemaphore-dep-box fs_0))) + (let ((dep-box_0 (if or-part_0 or-part_0 (let ((b_0 (box #f))) (begin (set-fsemaphore-dep-box! fs_0 b_0) - b_0)))))) - (begin - (lock-release (fsemaphore-lock fs_0)) - (1/sync (fsemaphore-box-evt2.1 dep-box_0)) - (1/fsemaphore-wait fs_0))))) + b_0))))) + (begin + (lock-release (fsemaphore-lock fs_0)) + (1/sync (fsemaphore-box-evt2.1 dep-box_0)) + (1/fsemaphore-wait fs_0)))))) (begin (set-fsemaphore-c! fs_0 (sub1 c_0)) (lock-release (fsemaphore-lock fs_0))))))))))) @@ -14869,11 +14842,10 @@ (begin (if (zero? (os-semaphore-count s_0)) (begin - (let ((app_0 (os-semaphore-condition s_0))) - (|#%app| - host:condition-wait - app_0 - (os-semaphore-mutex s_0))) + (|#%app| + host:condition-wait + (os-semaphore-condition s_0) + (os-semaphore-mutex s_0)) (loop_0)) (set-os-semaphore-count! s_0 diff --git a/racket/src/schemify/infer-known.rkt b/racket/src/schemify/infer-known.rkt index 6e36d5b250..6a7eb7c2bd 100644 --- a/racket/src/schemify/infer-known.rkt +++ b/racket/src/schemify/infer-known.rkt @@ -93,7 +93,7 @@ [`,_ (cond [(and defn - (simple? rhs prim-knowns knowns imports mutated simples)) + (simple? rhs prim-knowns knowns imports mutated simples unsafe-mode?)) a-known-constant] [else #f])])]))) diff --git a/racket/src/schemify/known.rkt b/racket/src/schemify/known.rkt index 17f02d1275..42c361db9b 100644 --- a/racket/src/schemify/known.rkt +++ b/racket/src/schemify/known.rkt @@ -19,6 +19,7 @@ known-procedure/can-inline/need-imports known-procedure/can-inline/need-imports? known-procedure/can-inline/need-imports-needed known-procedure/succeeds known-procedure/succeeds? + known-procedure/allocates known-procedure/allocates? known-procedure/pure known-procedure/pure? known-procedure/pure/folding known-procedure/pure/folding? ; not a subtype of `known-procedure/folding` known-procedure/pure/folding-unsafe known-procedure/pure/folding-unsafe? @@ -96,8 +97,11 @@ ;; procedure with single value that never raises an exception or otherwise captures/escapes the calling context (struct known-procedure/succeeds () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/no-prompt) -;; procedure that accepts any arguments, returns a single value, and is functional so that it can be reordered -(struct known-procedure/pure () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/succeeds) +;; procedure that accepts any arguments, returns a single value, and has allocation as its only effect +(struct known-procedure/allocates () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/succeeds) + +;; procedure that accepts any arguments, returns a single value, and has/observes no effect so that it can be reordered +(struct known-procedure/pure () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/allocates) ;; pure and folding: (struct known-procedure/pure/folding () #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure) @@ -112,7 +116,7 @@ (struct known-struct-type (type field-count pure-constructor?) #:prefab #:omit-define-syntaxes #:super struct:known-consistent) ;; procedures with a known connection to a structure type: -(struct known-constructor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure) +(struct known-constructor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/allocates) (struct known-predicate (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure) (struct known-accessor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/single-valued) (struct known-mutator (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/single-valued) diff --git a/racket/src/schemify/left-to-right.rkt b/racket/src/schemify/left-to-right.rkt index 760ca7f9fa..a11ac277ca 100644 --- a/racket/src/schemify/left-to-right.rkt +++ b/racket/src/schemify/left-to-right.rkt @@ -16,7 +16,7 @@ ;; expressions that have no shadowing (and introduce ;; shadowing here) (define (left-to-right/let ids rhss bodys - prim-knowns knowns imports mutated simples) + prim-knowns knowns imports mutated simples unsafe-mode?) (cond [(null? ids) (if (null? (cdr bodys)) (car bodys) @@ -30,7 +30,7 @@ (define id (car ids)) (define rhs (car rhss)) (if (and all-simple? - (simple? rhs prim-knowns knowns imports mutated simples)) + (simple? rhs prim-knowns knowns imports mutated simples unsafe-mode?)) `(let ([,id ,rhs]) . ,bodys) `(let ([,id ,rhs]) @@ -43,7 +43,7 @@ ,(loop (cdr ids) (cdr rhss) (and all-simple? - (simple? rhs prim-knowns knowns imports mutated simples)) + (simple? rhs prim-knowns knowns imports mutated simples unsafe-mode?)) (cons `[,id ,id] binds)))]))])) ;; Convert a `let-values` to nested `let-values`es to @@ -74,41 +74,63 @@ binds)) target)]))])) -;; Convert an application to enforce left-to-right -;; evaluation order +;; Convert an application to enforce left-to-right evaluation order. (define (left-to-right/app rator rands app-form target - prim-knowns knowns imports mutated simples) + prim-knowns knowns imports mutated simples unsafe-mode?) (cond [(aim? target 'cify) (cons rator rands)] [else - (let loop ([l (cons rator rands)] [accum null] [pending-non-simple #f] [pending-id #f]) - (cond - [(null? l) - (let ([app - (cond - [pending-non-simple - ;; Since the last non-simple was followed only by simples, - ;; we don't need that variable - (let loop ([accum accum] [rev-accum null]) - (cond - [(null? accum) rev-accum] - [(eq? (car accum) pending-id) - (loop (cdr accum) (cons pending-non-simple rev-accum))] - [else - (loop (cdr accum) (cons (car accum) rev-accum))]))] - [else (reverse accum)])]) - (if app-form - (cons app-form app) - app))] - [(simple? (car l) prim-knowns knowns imports mutated simples) - (loop (cdr l) (cons (car l) accum) pending-non-simple pending-id)] - [pending-non-simple - `(let ([,pending-id ,pending-non-simple]) - ,(loop l accum #f #f))] - [else - (define g (deterministic-gensym "app_")) - (loop (cdr l) (cons g accum) (car l) g)]))])) - + (define l (cons rator rands)) + (define modes + ;; If an argument is pure, we don't have to order it explicitly. + ;; If an argument is pure except for allocation, then we only have to + ;; order it if a later argument is non-pure. + (let loop ([l l]) + (cond + [(null? l) 'pure] + [else + (define modes (loop (cdr l))) + (cond + [(simple? (car l) prim-knowns knowns imports mutated simples unsafe-mode? #:no-alloc? #t) + (if (symbol? modes) + modes + (cons 'pure modes))] + [(simple? (car l) prim-knowns knowns imports mutated simples unsafe-mode?) ; allocates + (if (symbol? modes) + 'alloc + (cons 'bind modes))] + [else + (if (eq? modes 'pure) + (cons 'non-simple modes) + (cons 'bind modes))])]))) + (define no-bind-needed? + (let loop ([modes modes]) + (cond + [(symbol? modes) #t] + [(eq? (car modes) 'pure) (loop (cdr modes))] + [(eq? (car modes) 'non-simple) #t] + [else #f]))) + (cond + [no-bind-needed? + (if app-form + (cons app-form l) + l)] + [else + (let loop ([l l] [modes modes] [accum null]) + (cond + [(or (symbol? modes) + (eq? (car modes) 'non-simple)) + (define app (append (reverse accum) l)) + (if app-form + (cons app-form app) + app)] + [(eq? (car modes) 'bind) + (define g (deterministic-gensym "app_")) + `(let ([,g ,(car l)]) + ,(loop (cdr l) (cdr modes) (cons g accum)))] + [else + (loop (cdr l) (cdr modes) (cons (car l) accum))]))])])) + ;; ---------------------------------------- (define (make-let-values ids rhs body target) diff --git a/racket/src/schemify/mutated.rkt b/racket/src/schemify/mutated.rkt index 906ac1c926..d3170b83cd 100644 --- a/racket/src/schemify/mutated.rkt +++ b/racket/src/schemify/mutated.rkt @@ -69,11 +69,11 @@ ;; check individual property values using `ids`, so procedures won't ;; count as used until some instace is created (for ([e (in-list prop-vals)]) - (find-mutated! e ids prim-knowns knowns imports mutated simples))] + (find-mutated! e ids prim-knowns knowns imports mutated simples unsafe-mode?))] [else - (find-mutated! e ids prim-knowns knowns imports mutated simples)]))] + (find-mutated! e ids prim-knowns knowns imports mutated simples unsafe-mode?)]))] [else - (find-mutated! rhs ids prim-knowns knowns imports mutated simples)]) + (find-mutated! rhs ids prim-knowns knowns imports mutated simples unsafe-mode?)]) ;; For any among `ids` that didn't get a delay and wasn't used ;; too early, the variable is now ready, so remove from ;; `mutated`: @@ -82,7 +82,7 @@ (when (eq? 'not-ready (hash-ref mutated id #f)) (hash-remove! mutated id))))] [`,_ - (find-mutated! form #f prim-knowns knowns imports mutated simples)]) + (find-mutated! form #f prim-knowns knowns imports mutated simples unsafe-mode?)]) knowns) ;; For definitions that are not yet used, force delays: (for ([form (in-list l)]) @@ -101,7 +101,7 @@ ;; Schemify `let-values` to `let`, etc., and ;; reorganize struct bindings. -(define (find-mutated! top-v ids prim-knowns knowns imports mutated simples) +(define (find-mutated! top-v ids prim-knowns knowns imports mutated simples unsafe-mode?) (define (delay! ids thunk) (define done? #f) (define force (lambda () (unless done? @@ -153,7 +153,7 @@ [rhs (in-list rhss)]) (find-mutated! rhs (unwrap-list ids)) (define new-maybe-cc? (or maybe-cc? - (not (simple? rhs prim-knowns knowns imports mutated simples + (not (simple? rhs prim-knowns knowns imports mutated simples unsafe-mode? #:pure? #f #:result-arity (length ids))))) ;; Each `id` in `ids` is now ready (but might also hold a delay): @@ -222,7 +222,7 @@ (eq? rator 'make-struct-type-property)) (bitwise-bit-set? (known-procedure-arity-mask v) (length exps)))) (for/and ([exp (in-list exps)]) - (simple? exp prim-knowns knowns imports mutated simples))))) + (simple? exp prim-knowns knowns imports mutated simples unsafe-mode?))))) ;; Can delay construction (delay! ids (lambda () (find-mutated!* exps #f)))] [else diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 61f8708089..ef008c8c2f 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -377,23 +377,23 @@ (match schemified [`(define ,id ,rhs) (cond - [(simple? #:pure? #f rhs prim-knowns knowns imports mutated simples) + [(simple? #:pure? #f rhs prim-knowns knowns imports mutated simples unsafe-mode?) (finish-definition (list id))] [else (finish-wrapped-definition (list id) rhs)])] [`(define-values ,ids ,rhs) (cond - [(simple? #:pure? #f rhs prim-knowns knowns imports mutated simples + [(simple? #:pure? #f rhs prim-knowns knowns imports mutated simples unsafe-mode? #:result-arity (length ids)) (match rhs [`(values ,rhss ...) ;; Flatten `(define-values (id ...) (values rhs ...))` to ;; a sequence `(define id rhs) ...` (if (and (= (length rhss) (length ids)) - ;; Must be pure, otherwise a variable might be referenced + ;; Must be simple enough, otherwise a variable might be referenced ;; too early: (for/and ([rhs (in-list rhss)]) - (simple? rhs prim-knowns knowns imports mutated simples))) + (simple? rhs prim-knowns knowns imports mutated simples unsafe-mode?))) (let values-loop ([ids ids] [rhss rhss] [accum-exprs accum-exprs] [accum-ids accum-ids] [knowns knowns]) (cond [(null? ids) (loop (cdr l) mut-l accum-exprs accum-ids knowns)] @@ -422,7 +422,7 @@ (finish-definition ids (append set-vars accum-exprs) null)] [`,_ (cond - [(simple? #:pure? #f schemified prim-knowns knowns imports mutated simples + [(simple? #:pure? #f schemified prim-knowns knowns imports mutated simples unsafe-mode? #:result-arity #f) (loop (cdr l) mut-l (cons schemified accum-exprs) accum-ids knowns)] [else @@ -567,8 +567,8 @@ (schemify rhs 'fresh)) (for/list ([body (in-list bodys)]) (schemify/knowns new-knowns inline-fuel wcm-state body)) - prim-knowns knowns imports mutated simples) - prim-knowns knowns imports mutated simples)])] + prim-knowns knowns imports mutated simples unsafe-mode?) + prim-knowns knowns imports mutated simples unsafe-mode?)])] [`(let-values ([() (begin ,rhss ... (values))]) ,bodys ...) `(begin ,@(schemify-body rhss 'fresh) ,@(schemify-body bodys wcm-state))] [`(let-values ([,idss ,rhss] ...) ,bodys ...) @@ -584,7 +584,7 @@ (schemify-body bodys wcm-state) mutated target) - prim-knowns knowns imports mutated simples))] + prim-knowns knowns imports mutated simples unsafe-mode?))] [`(letrec-values () ,bodys ...) (schemify `(begin . ,bodys) wcm-state)] [`(letrec-values ([() (values)]) ,bodys ...) @@ -611,7 +611,7 @@ `[,id ,(schemify/knowns rhs-knowns inline-fuel 'fresh rhs)]) ,@(for/list ([body (in-list bodys)]) (schemify/knowns body-knowns inline-fuel wcm-state body)))) - prim-knowns knowns imports mutated simples)] + prim-knowns knowns imports mutated simples unsafe-mode?)] [`(letrec-values ([,idss ,rhss] ...) ,bodys ...) (cond [(struct-convert-local v #:letrec? #t prim-knowns knowns imports mutated simples @@ -661,7 +661,7 @@ (authentic-valued? key knowns prim-knowns imports mutated)) (cond [(and authentic-key? - (simple? s-body prim-knowns knowns imports mutated simples #:result-arity #f)) + (simple? s-body prim-knowns knowns imports mutated simples unsafe-mode? #:result-arity #f)) `(begin ,(ensure-single-valued s-key knowns prim-knowns imports mutated) ,(ensure-single-valued s-val knowns prim-knowns imports mutated) ,s-body)] @@ -761,7 +761,7 @@ (left-to-right/app 'equal? (list exp1 exp2) #f target - prim-knowns knowns imports mutated simples)]))] + prim-knowns knowns imports mutated simples unsafe-mode?)]))] [`(call-with-values ,generator ,receiver) (cond [(and (lambda? generator) @@ -772,7 +772,7 @@ (left-to-right/app (if (aim? target 'cify) 'call-with-values '#%call-with-values) (list (schemify generator 'fresh) (schemify receiver 'fresh)) #f target - prim-knowns knowns imports mutated simples)])] + prim-knowns knowns imports mutated simples unsafe-mode?)])] [`(single-flonum-available?) ;; Fold to a boolean to allow earlier simplification (aim? target 'cify)] @@ -835,7 +835,7 @@ (left-to-right/app 'unsafe-struct (cons (schemify type-id 'fresh) args) #f target - prim-knowns knowns imports mutated simples)] + prim-knowns knowns imports mutated simples unsafe-mode?)] [else #f])) (define (inline-struct-predicate k s-rator im args) (define type-id (and (known-struct-predicate-authentic? k) @@ -897,7 +897,7 @@ (left-to-right/app (car e) (cdr e) #f target - prim-knowns knowns imports mutated simples))] + prim-knowns knowns imports mutated simples unsafe-mode?))] [(and (not (or ;; Don't inline in cify mode, because cify takes care of it (aim? target 'cify) @@ -931,7 +931,7 @@ (left-to-right/app (known-procedure/has-unsafe-alternate k) args #f target - prim-knowns knowns imports mutated simples)] + prim-knowns knowns imports mutated simples unsafe-mode?)] [else (left-to-right/app s-rator args @@ -947,7 +947,7 @@ #f] [else '|#%app|]) target - prim-knowns knowns imports mutated simples)])))] + prim-knowns knowns imports mutated simples unsafe-mode?)])))] [`,_ (let ([u-v (unwrap v)]) (cond diff --git a/racket/src/schemify/simple.rkt b/racket/src/schemify/simple.rkt index 39d7247c36..6b3b7f13b2 100644 --- a/racket/src/schemify/simple.rkt +++ b/racket/src/schemify/simple.rkt @@ -9,24 +9,35 @@ simple/can-copy?) ;; Check whether an expression is simple in the sense that its order -;; of evaluation isn't detectable. This function receives both -;; schemified and non-schemified expressions. -(define (simple? e prim-knowns knowns imports mutated simples +;; of evaluation isn't detectable (`pure?` = #t) or at least it won't +;; try to capture a comtinuation (`pure?` = #f). In `pure?` mode, if +;; `no-alloc?` is true, then allocation counts as detectable (for +;; ordering with respect to functions that might capture a continuation). +;; This function receives both schemified and non-schemified expressions. +(define (simple? e prim-knowns knowns imports mutated simples unsafe-mode? #:pure? [pure? #t] + #:no-alloc? [no-alloc? #f] #:result-arity [result-arity 1]) (let simple? ([e e] [result-arity result-arity]) (define-syntax-rule (cached expr) - (let* ([c (hash-ref simples e #(unknown unknown 1))] - [r (vector-ref c (if pure? 0 1))] - [arity-match? (eqv? result-arity (vector-ref c 2))]) + (let* ([c (hash-ref simples e #(unknown unknown unknown 1))] + [r (vector-ref c (if pure? (if no-alloc? 1 0) 2))] + [arity-match? (eqv? result-arity (vector-ref c 3))]) (if (or (eq? 'unknown r) (not arity-match?)) (let ([r expr]) (hash-set! simples e (if pure? - (vector r - (if arity-match? (vector-ref c 1) 'unknown) - result-arity) + (if no-alloc? + (vector (if arity-match? (vector-ref c 0) 'unknown) + r + (if arity-match? (vector-ref c 2) 'unknown) + result-arity) + (vector r + (if arity-match? (vector-ref c 1) 'unknown) + (if arity-match? (vector-ref c 2) 'unknown) + result-arity)) (vector (if arity-match? (vector-ref c 0) 'unknown) + (if arity-match? (vector-ref c 1) 'unknown) r result-arity))) r) @@ -96,7 +107,11 @@ (let ([v (or (hash-ref-either knowns imports proc) (hash-ref prim-knowns proc #f))]) (and (if pure? - (and (known-procedure/pure? v) + (and (if no-alloc? + (known-procedure/pure? v) + (or (known-procedure/allocates? v) + (and unsafe-mode? + (known-accessor? v)))) (returns 1)) (and (or (known-procedure/no-prompt? v) (known-procedure/no-prompt/multi? v)) diff --git a/racket/src/schemify/single-valued.rkt b/racket/src/schemify/single-valued.rkt index db91113a10..a3664e885c 100644 --- a/racket/src/schemify/single-valued.rkt +++ b/racket/src/schemify/single-valued.rkt @@ -21,7 +21,7 @@ (simple-mutated-state? (hash-ref mutated u #f)) (let ([k (or (hash-ref prim-knowns u #f) (hash-ref-either knowns imports u))]) - (or (known-procedure/pure? k) + (or (known-procedure/allocates? k) (known-procedure/single-valued? k)))) v] [else `($value ,v)])] diff --git a/racket/src/schemify/struct-type-info.rkt b/racket/src/schemify/struct-type-info.rkt index 0b344eab04..ed5165aae6 100644 --- a/racket/src/schemify/struct-type-info.rkt +++ b/racket/src/schemify/struct-type-info.rkt @@ -128,7 +128,7 @@ (and (symbol? u-prop) (or (known-struct-type-property/immediate-guard? (find-known u-prop prim-knowns knowns imports mutated))) - (simple? val prim-knowns knowns imports mutated simples)))) + (simple? val prim-knowns knowns imports mutated simples #f)))) vals)] [`null null] [`'() null] diff --git a/racket/src/schemify/unnest-let.rkt b/racket/src/schemify/unnest-let.rkt index 9e50bed857..c756723897 100644 --- a/racket/src/schemify/unnest-let.rkt +++ b/racket/src/schemify/unnest-let.rkt @@ -29,7 +29,7 @@ ;; and are immediate `lambda` forms, though, to avoid ;; pessimizing a set of mutually recursive functions. -(define (unnest-let e prim-knowns knowns imports mutated simples) +(define (unnest-let e prim-knowns knowns imports mutated simples unsafe-mode?) (match e [`(,let-id (,binds ...) . ,body) (cond @@ -63,7 +63,7 @@ (for/and ([rhs (in-list rhss)]) (and (or (eq? 'let let-id) (immediate-lambda? rhs)) - (simple? rhs prim-knowns knowns imports mutated simples)))) + (simple? rhs prim-knowns knowns imports mutated simples unsafe-mode?)))) (match (car binds) [`[,_ (,_ ,inner-binds ,_)] (cond diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index a14882230c..f7665a088e 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 9 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 18 +#define MZSCHEME_VERSION_W 19 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x