suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
23300fd18d
racket/racket/src/cs/schemified/expander.scm
Matthew Flatt 23300fd18d cs: use nongenerative records in core
2020-12-30 15:34:46 -07:00

93386 lines
5.2 MiB
Raw Blame History

(export (rename (boot boot)
(1/bound-identifier=? bound-identifier=?)
(1/compile compile)
(compile-keep-source-locations! compile-keep-source-locations!)
(1/compiled-expression-recompile compiled-expression-recompile)
(1/current-compile current-compile)
(1/current-compiled-file-roots current-compiled-file-roots)
(1/current-eval current-eval)
(1/current-library-collection-links
current-library-collection-links)
(1/current-library-collection-paths
current-library-collection-paths)
(1/current-load current-load)
(1/current-load/use-compiled current-load/use-compiled)
(1/current-namespace current-namespace)
(datum->kernel-syntax datum->kernel-syntax)
(1/datum->syntax datum->syntax)
(declare-primitive-module! declare-primitive-module!)
(1/dynamic-require dynamic-require)
(embedded-load embedded-load)
(1/eval eval)
(eval$1 eval-top-level)
(expand$1 expand)
(expander-place-init! expander-place-init!)
(1/find-library-collection-links find-library-collection-links)
(1/find-library-collection-paths find-library-collection-paths)
(find-main-config find-main-config)
(1/identifier-binding identifier-binding)
(identifier? identifier?)
(1/load load)
(1/load-extension load-extension)
(1/load/use-compiled load/use-compiled)
(make-namespace make-namespace)
(maybe-raise-missing-module maybe-raise-missing-module)
(maybe-syntax->datum maybe-syntax->datum)
(1/module->language-info module->language-info)
(1/module-compiled-exports module-compiled-exports)
(1/module-compiled-indirect-exports
module-compiled-indirect-exports)
(1/module-declared? module-declared?)
(1/module-path-index-join module-path-index-join)
(1/module-path-index? module-path-index?)
(1/module-path? module-path?)
(1/module-predefined? module-predefined?)
(namespace->instance namespace->instance)
(1/namespace-attach-module namespace-attach-module)
(1/namespace-attach-module-declaration
namespace-attach-module-declaration)
(namespace-datum-introduce namespace-datum-introduce)
(1/namespace-mapped-symbols namespace-mapped-symbols)
(1/namespace-module-identifier namespace-module-identifier)
(1/namespace-require namespace-require)
(1/namespace-syntax-introduce namespace-syntax-introduce)
(1/namespace-variable-value namespace-variable-value)
(path-list-string->path-list path-list-string->path-list)
(1/read read)
(1/read-accept-compiled read-accept-compiled)
(1/read-syntax read-syntax)
(1/resolved-module-path? resolved-module-path?)
(seal seal)
(1/syntax->datum syntax->datum)
(1/syntax-debug-info syntax-debug-info)
(1/syntax-e syntax-e)
(syntax-property$1 syntax-property)
(1/syntax-shift-phase-level syntax-shift-phase-level)
(syntax?$1 syntax?)
(1/use-collection-link-paths use-collection-link-paths)
(1/use-compiled-file-check use-compiled-file-check)
(1/use-compiled-file-paths use-compiled-file-paths)
(1/use-user-specific-search-paths
use-user-specific-search-paths)))
(define rx2276 (regexp "^[\\][\\][?][\\]"))
(define rx2490 (byte-regexp #vu8(94 91 92 93 91 92 93 91 63 93 91 92 93)))
(define rx2515 (regexp "/"))
(define rx2283 (regexp "[/\\][. ]+[/\\]*$"))
(define rx2458 (regexp "(?<=[^ ./\\])[ .]+([/\\]*)$"))
(define rx2566 (regexp "^\\\\\\\\[?]\\\\[a-z]:"))
(define rx2590 (regexp "^\\\\\\\\[?]\\\\UNC\\\\"))
(define rx2623 (regexp "^\\\\\\\\"))
(define rx2947 (regexp "^[a-z]:"))
(define rx2199 (byte-regexp #vu8(34)))
(define hash2725 (hash))
(define hash2610 (hasheq))
(define hash2589 (hasheqv))
(define rx2668 (regexp "[.]"))
(define rx2640 (regexp "[.](..).*"))
(define kw2299 (string->keyword "resolved-module-path"))
(define kw2226 (string->keyword "syntax+props"))
(define kw2099 (string->keyword "datum->syntax"))
(define kw2641 (string->keyword "syntax"))
(define kw2804 (string->keyword "module-binding"))
(define kw1932 (string->keyword "inspector"))
(define kw2755 (string->keyword "simple-module-binding"))
(define kw2169 (string->keyword "table-with-bulk-bindings"))
(define kw2707 (string->keyword "bulk-binding-at"))
(define kw2576 (string->keyword "scope-fill!"))
(define kw2129 (string->keyword "scope"))
(define kw2535 (string->keyword "scope+kind"))
(define kw2241 (string->keyword "interned-scope"))
(define kw2645 (string->keyword "multi-scope"))
(define kw2073 (string->keyword "representative-scope-fill!"))
(define kw2600 (string->keyword "representative-scope"))
(define kw2201 (string->keyword "shifted-multi-scope"))
(define kw2450 (string->keyword "none"))
(define kw2677 (string->keyword "local-binding"))
(define kw2897 (string->keyword "provided"))
(define kw2762 (string->keyword "bulk-binding"))
(define kw2607 (string->keyword "bulk-binding-registry"))
(define kw2626 (string->keyword "quote"))
(define kw2603 (string->keyword "ref"))
(define kw3163 (string->keyword "mpi"))
(define kw2802 (string->keyword "list"))
(define kw2821 (string->keyword "cons"))
(define kw2525 (string->keyword "box"))
(define kw2967 (string->keyword "vector"))
(define kw3357 (string->keyword "seteq"))
(define kw2333 (string->keyword "seteqv"))
(define kw2473 (string->keyword "set"))
(define kw2796 (string->keyword "hasheq"))
(define kw3245 (string->keyword "hasheqv"))
(define kw2582 (string->keyword "hash"))
(define kw2931 (string->keyword "prefab"))
(define kw2496 (string->keyword "srcloc"))
(define kw2531 (string->keyword "set-box!"))
(define kw3046 (string->keyword "set-vector!"))
(define kw2194 (string->keyword "set-hash!"))
(define hash2936
(hasheq
kw2525
'10
kw2762
'27
kw2707
'22
kw2607
'3
kw2821
'11
kw2099
'5
kw2582
'13
kw2796
'13
kw3245
'13
kw1932
'2
kw2241
'18
kw2802
'12
kw2677
'26
kw2804
'24
kw3163
'9
kw2645
'19
kw2931
'15
kw2897
'28
kw2626
'8
kw2603
'1
kw2600
'23
kw2129
'16
kw2535
'17
kw2473
'14
kw3357
'14
kw2333
'14
kw2201
'20
kw2755
'25
kw2496
'7
kw2641
'4
kw2226
'6
kw2169
'21
kw2967
'12))
(define kw2162 (string->keyword "not-recorded"))
(define hash2430
(hasheq
'|#%variable-reference|
'1
'begin
'5
'begin0
'6
'case-lambda
'1
'gensym
'12
'if
'13
'lambda
'1
'let-values
'2
'letrec-values
'2
'make-parameter
'7
'make-struct-field-accessor
'9
'make-struct-field-mutator
'10
'make-struct-type
'8
'make-struct-type-property
'11
'quote
'1
'values
'3
'void
'4))
(define kw2208 (string->keyword "cross-phase-persistent"))
(define kw2910 (string->keyword "empty-namespace"))
(define kw2838 (string->keyword "unsafe"))
(define hash3012
(hash
'block->letrec
'3
'block->list
'0
'block-renames
'2
'enter-begin-for-syntax
'0
'enter-bind
'0
'enter-block
'1
'enter-list
'1
'enter-local
'1
'enter-macro
'2
'enter-prim
'1
'exit-begin-for-syntax
'0
'exit-bind
'0
'exit-case
'1
'exit-list
'1
'exit-local
'1
'exit-local-bind
'0
'exit-macro
'2
'exit-prim
'1
'exit-prim/return
'1
'finish-block
'1
'lambda-renames
'2
'letX-renames
'5
'letlift-loop
'1
'lift-end-decl
'3
'lift-expr
'3
'lift-loop
'1
'lift-module
'2
'lift-provide
'1
'lift-require
'3
'local-bind
'1
'local-post
'1
'local-pre
'1
'local-value
'1
'local-value-result
'1
'macro-post-x
'2
'macro-pre-x
'1
'module-body
'1
'module-end-lifts
'1
'module-lift-end-loop
'1
'module-lift-loop
'1
'module-pass1-case
'1
'module-pass1-lifts
'3
'module-pass2-lifts
'3
'next
'0
'next-group
'0
'opaque-expr
'1
'phase-up
'0
'prepare-env
'0
'|prim-#%app|
'1
'|prim-#%datum|
'1
'|prim-#%expression|
'1
'|prim-#%stratified|
'1
'|prim-#%top|
'1
'|prim-#%variable-reference|
'1
'prim-begin
'1
'prim-begin-for-syntax
'1
'prim-begin0
'1
'prim-case-lambda
'1
'prim-declare
'1
'prim-define-syntaxes
'1
'prim-define-values
'1
'prim-if
'1
'prim-lambda
'1
'prim-let-values
'1
'prim-letrec-syntaxes+values
'1
'prim-letrec-values
'1
'prim-module
'1
'prim-module-begin
'1
'prim-provide
'1
'prim-quote
'1
'prim-quote-syntax
'1
'prim-require
'1
'prim-set!
'1
'prim-stop
'1
'prim-submodule
'1
'prim-submodule*
'1
'prim-with-continuation-mark
'1
'rename-list
'1
'rename-one
'1
'rename-transformer
'1
'resolve
'1
'return
'1
'splice
'1
'start
'0
'start-top
'0
'stop/return
'1
'tag
'1
'tag/context
'1
'tag2
'2
'track-syntax
'3
'variable
'2
'visit
'1))
(define kw2836 (string->keyword "missing"))
(define nhash2607 (cons #f (hasheq)))
(define rx2897 (regexp "/+"))
(define rx2937 (regexp "[.]zo$"))
(define rx2823 (regexp "\n"))
(define rx2418 (regexp "[.]ss$"))
(define kw2186 (string->keyword "local"))
(define hash2294
(hasheq
'all-defined
'9
'all-defined-except
'10
'all-from
'7
'all-from-except
'8
'expand
'13
'for-label
'3
'for-meta
'1
'for-syntax
'2
'prefix-all-defined
'11
'prefix-all-defined-except
'12
'protect
'4
'rename
'5
'struct
'6))
(define kws2278
(cons
(string->keyword "cross-phase-persistent")
(cons
(string->keyword "empty-namespace")
(cons (string->keyword "unsafe") '()))))
(define call/ec call-with-escape-continuation)
(define qq-append
(lambda (a_0 b_0)
(if (list? a_0)
(append a_0 b_0)
(raise-argument-error 'unquote-splicing "list?" a_0))))
(define bad-list$1
(|#%name|
bad-list
(lambda (who_0 orig-l_0)
(begin (raise-mismatch-error who_0 "not a proper list: " orig-l_0)))))
(define memq
(|#%name|
memq
(lambda (v_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'memq
"not a proper list: "
orig-l_0))
(if (eq? v_0 (car ls_0)) ls_0 (loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_0))))))
(define memv
(|#%name|
memv
(lambda (v_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'memv
"not a proper list: "
orig-l_0))
(if (eqv? v_0 (car ls_0)) ls_0 (loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_0))))))
(define member
(let ((default_0
(|#%name|
member
(lambda (v_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'member
"not a proper list: "
orig-l_0))
(if (equal? v_0 (car ls_0))
ls_0
(loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_0)))))))
(|#%name|
member
(case-lambda
((v_0 orig-l_0) (begin (default_0 v_0 orig-l_0)))
((v_0 orig-l_0 eq?_0)
(begin
(if (if (procedure? eq?_0) (procedure-arity-includes? eq?_0 2) #f)
(void)
(raise-argument-error
'member
"(procedure-arity-includes/c 2)"
eq?_0))
((|#%name|
member
(lambda (v_1 orig-l_1)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'member
"not a proper list: "
orig-l_1))
(if (|#%app| eq?_0 v_1 (car ls_0))
ls_0
(loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_1)))))
v_0
orig-l_0)))))))
(define current-parameterization
(lambda () (continuation-mark-set-first #f parameterization-key)))
(define call-with-parameterization
(lambda (paramz_0 thunk_0)
(begin
(if (parameterization? paramz_0)
(void)
(raise-argument-error
'call-with-parameterization
"parameterization?"
0
paramz_0
thunk_0))
(if (if (procedure? thunk_0) (procedure-arity-includes? thunk_0 0) #f)
(void)
(raise-argument-error
'call-with-parameterization
"(-> any)"
1
paramz_0
thunk_0))
(with-continuation-mark*
authentic
parameterization-key
paramz_0
(|#%app| thunk_0)))))
(define-values
(struct:break-paramz
make-break-paramz
break-paramz?
break-paramz-ref
break-paramz-set!)
(make-struct-type 'break-parameterization #f 1 0 #f))
(define current-break-parameterization
(lambda ()
(make-break-paramz (continuation-mark-set-first #f break-enabled-key))))
(define call-with-break-parameterization
(lambda (paramz_0 thunk_0)
(begin
(if (break-paramz? paramz_0)
(void)
(raise-argument-error
'call-with-break-parameterization
"break-parameterization?"
0
paramz_0
thunk_0))
(if (if (procedure? thunk_0) (procedure-arity-includes? thunk_0 0) #f)
(void)
(raise-argument-error
'call-with-parameterization
"(-> any)"
1
paramz_0
thunk_0))
(begin0
(with-continuation-mark*
push-authentic
break-enabled-key
(|#%app| break-paramz-ref paramz_0 0)
(begin (check-for-break) (|#%app| thunk_0)))
(check-for-break)))))
(define select-handler/no-breaks
(lambda (e_0 bpz_0 l_0)
(with-continuation-mark*
authentic
break-enabled-key
(make-thread-cell #f)
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? l_1)
(raise e_0)
(if (|#%app| (caar l_1) e_0)
(begin0
(|#%app| (cdar l_1) e_0)
(with-continuation-mark*
push-authentic
break-enabled-key
bpz_0
(check-for-break)))
(loop_0 (cdr l_1)))))))))
(loop_0 l_0)))))
(define false-thread-cell (make-thread-cell #f))
(define handler-prompt-key (make-continuation-prompt-tag 'handler-prompt-tag))
(define call-handled-body
(lambda (bpz_0 handle-proc_0 body-thunk_0)
(with-continuation-mark*
authentic
break-enabled-key
false-thread-cell
(call-with-continuation-prompt
(lambda (bpz_1 body-thunk_1)
(with-continuation-mark*
authentic
break-enabled-key
bpz_1
(with-continuation-mark*
authentic
exception-handler-key
(lambda (e_0) (abort-current-continuation handler-prompt-key e_0))
(|#%app| body-thunk_1))))
handler-prompt-key
handle-proc_0
bpz_0
body-thunk_0))))
(define call-with-exception-handler
(lambda (exnh_0 thunk_0)
(begin0
(with-continuation-mark*
push-authentic
exception-handler-key
exnh_0
(|#%app| thunk_0))
(void))))
(define not-there (gensym))
(define do-hash-update
(lambda (who_0 mut?_0 set_0 ht_0 key_0 xform_0 default_0)
(begin
(let ((v_0 (hash-ref ht_0 key_0 default_0)))
(if (eq? v_0 not-there)
(raise-mismatch-error who_0 "no value found for key: " key_0)
(|#%app| set_0 ht_0 key_0 (|#%app| xform_0 v_0)))))))
(define hash-update
(case-lambda
((ht_0 key_0 xform_0 default_0)
(do-hash-update 'hash-update #f hash-set ht_0 key_0 xform_0 default_0))
((ht_0 key_0 xform_0)
(begin-unsafe
(do-hash-update 'hash-update #f hash-set ht_0 key_0 xform_0 not-there)))))
(define hash-update!
(case-lambda
((ht_0 key_0 xform_0 default_0)
(do-hash-update 'hash-update! #t hash-set! ht_0 key_0 xform_0 default_0))
((ht_0 key_0 xform_0)
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
ht_0
key_0
xform_0
not-there)))))
(define hash-ref!
(lambda (ht_0 key_0 new_0)
(begin
(if (if (hash? ht_0) (not (immutable? ht_0)) #f)
(void)
(raise-argument-error
'hash-ref!
"(and/c hash? (not/c immutable?))"
0
ht_0
key_0
new_0))
(let ((v_0 (hash-ref ht_0 key_0 not-there)))
(if (eq? not-there v_0)
(let ((n_0 (if (procedure? new_0) (|#%app| new_0) new_0)))
(begin (hash-set! ht_0 key_0 n_0) n_0))
v_0)))))
(define path-string?
(lambda (s_0)
(let ((or-part_0 (path? s_0)))
(if or-part_0
or-part_0
(if (string? s_0)
(let ((or-part_1 (relative-path? s_0)))
(if or-part_1 or-part_1 (absolute-path? s_0)))
#f)))))
(define bsbs (string '#\x5c '#\x5c))
(define normal-case-path
(lambda (s_0)
(begin
(if (let ((or-part_0 (path-for-some-system? s_0)))
(if or-part_0 or-part_0 (path-string? s_0)))
(void)
(raise-argument-error
'normal-path-case
"(or/c path-for-some-system? path-string?)"
s_0))
(if (if (path-for-some-system? s_0)
(eq? (path-convention-type s_0) 'windows)
(eq? (system-type) 'windows))
(let ((bstr_0 (if (string? s_0) #f (path->bytes s_0))))
(if (if (string? s_0) (regexp-match? rx2276 s_0) #f)
(string->path s_0)
(if (if bstr_0 (regexp-match? rx2490 bstr_0) #f)
s_0
(let ((norm_0
(|#%name|
norm
(lambda (s_1)
(begin
(string-locale-downcase
(regexp-replace* rx2515 s_1 bsbs)))))))
(let ((norm-tail_0
(|#%name|
norm-tail
(lambda (s_1)
(begin
(if (regexp-match? rx2283 s_1)
s_1
(regexp-replace* rx2458 s_1 "\\1")))))))
(let ((finish_0
(|#%name|
finish
(lambda (bstr_1)
(begin (bytes->path bstr_1 'windows))))))
(if (string? s_0)
(let ((bstr_1
(string->bytes/locale
(norm_0 (norm-tail_0 s_0)))))
(begin-unsafe (begin (bytes->path bstr_1 'windows))))
(let ((c_0 (bytes-open-converter "" "UTF-8")))
(let ((bstr_1
(letrec*
((loop_0
(|#%name|
loop
(lambda (offset_0)
(begin
(call-with-values
(lambda ()
(bytes-convert
c_0
bstr_0
offset_0
(unsafe-bytes-length bstr_0)))
(case-lambda
((new-bstr_0 used_0 status_0)
(let ((s_1
(bytes->string/locale
new-bstr_0)))
(let ((tail-s_0
(if (eq? status_0 'complete)
(norm-tail_0 s_1)
s_1)))
(let ((done_0
(string->bytes/locale
(norm_0 tail-s_0))))
(if (eq? status_0 'complete)
done_0
(if (eq? status_0 'aborts)
(bytes-append
done_0
(subbytes
bstr_0
(+ offset_0 used_0)))
(let ((app_0
(let ((app_0
(+
offset_0
used_0)))
(subbytes
bstr_0
app_0
(+
offset_0
used_0
1)))))
(bytes-append
done_0
app_0
(loop_0
(+
offset_0
used_0
1))))))))))
(args
(raise-binding-result-arity-error
3
args)))))))))
(loop_0 0))))
(begin-unsafe
(begin (bytes->path bstr_1 'windows))))))))))))
(if (string? s_0) (string->path s_0) s_0)))))
(define check-extension-call
(lambda (s_0 sfx_0 who_0 sep_0 trust-sep?_0)
(begin
(call-with-values
(lambda ()
(if (not
(let ((or-part_0 (path-for-some-system? s_0)))
(if or-part_0 or-part_0 (path-string? s_0))))
(values "(or/c path-for-some-system? path-string?)" 0)
(if (not
(let ((or-part_0 (string? sfx_0)))
(if or-part_0 or-part_0 (bytes? sfx_0))))
(values "(or/c string? bytes?)" 1)
(if (not
(if trust-sep?_0
trust-sep?_0
(let ((or-part_0 (string? sep_0)))
(if or-part_0 or-part_0 (bytes? sep_0)))))
(values "(or/c string? bytes?)" 2)
(values #f #f)))))
(case-lambda
((err-msg_0 err-index_0)
(if err-msg_0
(if trust-sep?_0
(raise-argument-error who_0 err-msg_0 err-index_0 s_0 sfx_0)
(raise-argument-error
who_0
err-msg_0
err-index_0
s_0
sfx_0
sep_0))
(void)))
(args (raise-binding-result-arity-error 2 args))))
(call-with-values
(lambda () (split-path s_0))
(case-lambda
((base_0 name_0 dir?_0)
(begin
(if (not base_0)
(raise-mismatch-error
who_0
"cannot add an extension to a root path: "
s_0)
(void))
(values base_0 name_0)))
(args (raise-binding-result-arity-error 3 args)))))))
(define path-adjust-extension
(lambda (name_0 sep_0 rest-bytes_0 s_0 sfx_0 trust-sep?_0)
(call-with-values
(lambda () (check-extension-call s_0 sfx_0 name_0 sep_0 trust-sep?_0))
(case-lambda
((base_0 name_1)
(let ((bs_0 (path-element->bytes name_1)))
(let ((finish_0
(|#%name|
finish
(lambda (i_0 sep_1 i2_0)
(begin
(let ((app_0
(let ((app_0 (subbytes bs_0 0 i_0)))
(let ((app_1
(if (string? sep_1)
(string->bytes/locale sep_1 63)
sep_1)))
(let ((app_2 (|#%app| rest-bytes_0 bs_0 i2_0)))
(bytes-append
app_0
app_1
app_2
(if (string? sfx_0)
(string->bytes/locale sfx_0 63)
sfx_0)))))))
(bytes->path-element
app_0
(if (path-for-some-system? s_0)
(path-convention-type s_0)
(system-path-convention-type)))))))))
(let ((new-name_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (zero? i_0)
(finish_0
(unsafe-bytes-length bs_0)
#vu8()
(unsafe-bytes-length bs_0))
(let ((i_1 (sub1 i_0)))
(if (if (not (zero? i_1))
(eq? 46 (unsafe-bytes-ref bs_0 i_1))
#f)
(finish_0 i_1 sep_0 (add1 i_1))
(loop_0 i_1)))))))))
(loop_0 (unsafe-bytes-length bs_0)))))
(if (path-for-some-system? base_0)
(build-path base_0 new-name_0)
new-name_0)))))
(args (raise-binding-result-arity-error 2 args))))))
(define path-replace-extension
(lambda (s_0 sfx_0)
(path-adjust-extension
'path-replace-extension
#vu8()
(lambda (bs_0 i_0) #vu8())
s_0
sfx_0
#t)))
(define path-add-extension
(case-lambda
((s_0 sfx_0)
(path-adjust-extension 'path-add-extension #vu8(95) subbytes s_0 sfx_0 #t))
((s_0 sfx_0 sep_0)
(path-adjust-extension 'path-add-extension sep_0 subbytes s_0 sfx_0 #f))))
(define reroot-path
(lambda (p_0 root_0)
(begin
(if (let ((or-part_0 (path-string? p_0)))
(if or-part_0 or-part_0 (path-for-some-system? p_0)))
(void)
(raise-argument-error
'reroot-path
"(or/c path-string? path-for-some-system?)"
0
p_0
root_0))
(begin
(if (let ((or-part_0 (path-string? root_0)))
(if or-part_0 or-part_0 (path-for-some-system? root_0)))
(void)
(raise-argument-error
'reroot-path
"(or/c path-string? path-for-some-system?)"
1
p_0
root_0))
(let ((conv_0
(if (path-for-some-system? p_0)
(path-convention-type p_0)
(system-path-convention-type))))
(begin
(if (let ((or-part_0 (complete-path? p_0)))
(if or-part_0
or-part_0
(eq? (system-path-convention-type) conv_0)))
(void)
(raise-arguments-error
'reroot-path
"path is not complete and not the platform's convention"
"path"
p_0
"platform convention type"
(system-path-convention-type)))
(begin
(if (eq?
(if (path-for-some-system? root_0)
(path-convention-type root_0)
(system-path-convention-type))
conv_0)
(void)
(raise-arguments-error
'reroot-path
"given paths use different conventions"
"path"
p_0
"root path"
root_0))
(let ((c-p_0
(normal-case-path
(cleanse-path
(if (complete-path? p_0)
p_0
(path->complete-path p_0))))))
(let ((bstr_0 (path->bytes c-p_0)))
(if (eq? conv_0 'unix)
(if (bytes=? bstr_0 #vu8(47))
(if (path-for-some-system? root_0)
root_0
(string->path root_0))
(build-path
root_0
(bytes->path (subbytes (path->bytes c-p_0) 1) conv_0)))
(if (eq? conv_0 'windows)
(build-path
root_0
(bytes->path
(if (regexp-match? rx2566 bstr_0)
(let ((app_0 (subbytes bstr_0 4 5)))
(bytes-append
#vu8(92 92 63 92 82 69 76 92)
app_0
#vu8(92)
(subbytes bstr_0 6)))
(if (regexp-match? rx2590 bstr_0)
(bytes-append
#vu8(92 92 63 92 82 69 76 92)
(subbytes bstr_0 4))
(if (regexp-match? rx2590 bstr_0)
(bytes-append
#vu8(92 92 63 92 82 69 76 92)
(subbytes bstr_0 4))
(if (regexp-match? rx2623 bstr_0)
(bytes-append #vu8(85 78 67 92) (subbytes bstr_0 2))
(if (regexp-match? rx2947 bstr_0)
(let ((app_0 (subbytes bstr_0 0 1)))
(bytes-append app_0 (subbytes bstr_0 2)))
(void))))))
conv_0))
(void))))))))))))
(define rx:path-list #f)
(define init-rx:path-list!
(lambda ()
(if rx:path-list
(void)
(set! rx:path-list
(byte-regexp
(string->bytes/utf-8
(let ((sep_0 (if (eq? (system-type) 'windows) ";" ":")))
(format "([^~a]*)~a(.*)" sep_0 sep_0))))))))
(define cons-path
(lambda (default_0 s_0 l_0)
(let ((s_1
(if (eq? (system-type) 'windows)
(regexp-replace* rx2199 s_0 #vu8())
s_0)))
(if (bytes=? s_1 #vu8())
(append default_0 l_0)
(cons (bytes->path s_1) l_0)))))
(define path-list-string->path-list
(lambda (s_0 default_0)
(begin
(if (let ((or-part_0 (bytes? s_0)))
(if or-part_0 or-part_0 (string? s_0)))
(void)
(raise-argument-error
'path-list-string->path-list
"(or/c bytes? string?)"
s_0))
(if (if (list? default_0) (andmap path? default_0) #f)
(void)
(raise-argument-error
'path-list-string->path-list
"(listof path?)"
default_0))
(init-rx:path-list!)
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(let ((m_0 (regexp-match rx:path-list s_1)))
(if m_0
(let ((app_0 (cadr m_0)))
(cons-path default_0 app_0 (loop_0 (caddr m_0))))
(cons-path default_0 s_1 null))))))))
(loop_0 (if (string? s_0) (string->bytes/utf-8 s_0) s_0))))))
(define find-executable-path
(case-lambda
((program_0 libpath_0 reverse?_0)
(begin
(if (path-string? program_0)
(void)
(raise-argument-error 'find-executable-path "path-string?" program_0))
(if (let ((or-part_0 (not libpath_0)))
(if or-part_0
or-part_0
(if (path-string? libpath_0) (relative-path? libpath_0) #f)))
(void)
(raise-argument-error
'find-executable-path
"(or/c #f (and/c path-string? relative-path?))"
libpath_0))
(letrec*
((found-exec_0
(|#%name|
found-exec
(lambda (exec-name_0)
(begin
(if libpath_0
(call-with-values
(lambda () (split-path exec-name_0))
(case-lambda
((base_0 name_0 isdir?_0)
(let ((next_0
(|#%name|
next
(lambda ()
(begin
(let ((resolved_0 (resolve-path exec-name_0)))
(if (equal? resolved_0 exec-name_0)
#f
(if (relative-path? resolved_0)
(found-exec_0
(build-path base_0 resolved_0))
(found-exec_0 resolved_0)))))))))
(let ((or-part_0 (if reverse?_0 (next_0) #f)))
(if or-part_0
or-part_0
(let ((or-part_1
(if (path? base_0)
(let ((lib_0 (build-path base_0 libpath_0)))
(if (let ((or-part_1
(directory-exists? lib_0)))
(if or-part_1
or-part_1
(file-exists? lib_0)))
lib_0
#f))
#f)))
(if or-part_1
or-part_1
(if (not reverse?_0) (next_0) #f)))))))
(args (raise-binding-result-arity-error 3 args))))
exec-name_0))))))
(if (if (relative-path? program_0)
(call-with-values
(lambda () (split-path program_0))
(case-lambda
((base_0 name_0 dir?_0) (eq? base_0 'relative))
(args (raise-binding-result-arity-error 3 args))))
#f)
(let ((paths-str_0
(environment-variables-ref
(current-environment-variables)
#vu8(80 65 84 72))))
(let ((win-add_0
(|#%name|
win-add
(lambda (s_0)
(begin
(if (eq? (system-type) 'windows)
(cons (bytes->path #vu8(46)) s_0)
s_0))))))
(let ((paths-str_1 paths-str_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (paths_0)
(begin
(if (null? paths_0)
#f
(let ((base_0 (path->complete-path (car paths_0))))
(let ((name_0 (build-path base_0 program_0)))
(if (file-exists? name_0)
(found-exec_0 name_0)
(loop_0 (cdr paths_0)))))))))))
(loop_0
(win-add_0
(if paths-str_1
(path-list-string->path-list
(bytes->string/locale paths-str_1 '#\x3f)
null)
null)))))))
(let ((p_0 (path->complete-path program_0)))
(if (file-exists? p_0) (found-exec_0 p_0) #f))))))
((program_0 libpath_0) (find-executable-path program_0 libpath_0 #f))
((program_0) (find-executable-path program_0 #f #f))))
(define call-with-default-reading-parameterization
(lambda (thunk_0)
(if (if (procedure? thunk_0) (procedure-arity-includes? thunk_0 0) #f)
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
read-case-sensitive
#t
1/read-square-bracket-as-paren
#t
1/read-curly-brace-as-paren
#t
1/read-square-bracket-with-tag
#f
1/read-curly-brace-with-tag
#f
1/read-accept-box
#t
1/read-accept-compiled
#f
read-accept-bar-quote
#t
1/read-accept-graph
#t
1/read-decimal-as-inexact
#t
1/read-single-flonum
#f
1/read-cdot
#f
1/read-accept-dot
#t
1/read-accept-infix-dot
#t
1/read-accept-quasiquote
#t
1/read-accept-reader
#f
1/read-accept-lang
#t
1/current-readtable
#f)
(|#%app| thunk_0))
(raise-argument-error
'call-with-default-reading-parameterization
"(procedure-arity-includes/c 0)"
thunk_0))))
(define-values
(prop:keyword-impersonator keyword-impersonator? keyword-impersonator-ref)
(make-struct-type-property 'keyword-impersonator))
(define keyword-procedure-impersonator-of
(lambda (v_0)
(if (keyword-impersonator? v_0)
(|#%app| (keyword-impersonator-ref v_0) v_0)
#f)))
(define-values
(struct:keyword-procedure
mk-kw-proc
keyword-procedure?
keyword-procedure-ref
keyword-procedure-set!)
(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
(make-struct-field-accessor keyword-procedure-ref 3))
(define-values
(prop:procedure-accessor procedure-accessor? procedure-accessor-ref)
(make-struct-type-property
'procedure
(lambda (v_0 info-l_0)
(if (exact-integer? v_0)
(make-struct-field-accessor (list-ref info-l_0 3) v_0)
#f))))
(define-values
(new-prop:procedure new-procedure? new-procedure-ref)
(make-struct-type-property
'procedure
#f
(list (cons prop:procedure values) (cons prop:procedure-accessor values))
#t))
(define procedure-keywords
(lambda (p_0)
(if (keyword-procedure? p_0)
(let ((app_0 (keyword-procedure-required p_0)))
(values app_0 (keyword-procedure-allowed p_0)))
(if (procedure? p_0)
(if (new-procedure? p_0)
(let ((v_0 (new-procedure-ref p_0)))
(if (procedure? v_0)
(procedure-keywords v_0)
(let ((a_0 (procedure-accessor-ref p_0)))
(if a_0
(procedure-keywords (|#%app| a_0 p_0))
(values null null)))))
(values null null))
(raise-argument-error 'procedure-keywords "procedure?" p_0)))))
(define print-values
(lambda vs_0 (begin (for-each (current-print) vs_0) (apply values vs_0))))
(define reverse$1
(|#%name|
reverse
(lambda (l_0)
(begin
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (a_0 l_1)
(begin
(if (null? l_1)
a_0
(let ((app_0 (cons (car l_1) a_0)))
(loop_0 app_0 (cdr l_1)))))))))
(loop_0 null l_0)))))))
(define-values
(sort vector-sort vector-sort!)
(let ((generic-sort_0
(|#%name|
generic-sort
(lambda (A_0 less-than?_0 n_0)
(begin
(let ((n/2-_0 (unsafe-fxrshift n_0 1)))
(let ((n/2+_0 (unsafe-fx- n_0 n/2-_0)))
(letrec*
((copying-mergesort_0
(|#%name|
copying-mergesort
(lambda (Alo_0 Blo_0 n_1)
(begin
(if (unsafe-fx= n_1 1)
(unsafe-vector-set!
A_0
Blo_0
(unsafe-vector-ref A_0 Alo_0))
(if (unsafe-fx= n_1 2)
(let ((x_0 (unsafe-vector-ref A_0 Alo_0)))
(let ((y_0
(unsafe-vector-ref
A_0
(unsafe-fx+ Alo_0 1))))
(let ((x_1 x_0))
(if (|#%app| less-than?_0 y_0 x_1)
(begin
(unsafe-vector-set! A_0 Blo_0 y_0)
(unsafe-vector-set!
A_0
(unsafe-fx+ Blo_0 1)
x_1))
(begin
(unsafe-vector-set! A_0 Blo_0 x_1)
(unsafe-vector-set!
A_0
(unsafe-fx+ Blo_0 1)
y_0))))))
(if (unsafe-fx< n_1 16)
(begin
(unsafe-vector-set!
A_0
Blo_0
(unsafe-vector-ref A_0 Alo_0))
(letrec*
((iloop_0
(|#%name|
iloop
(lambda (i_0)
(begin
(if (unsafe-fx< i_0 n_1)
(let ((ref-i_0
(unsafe-vector-ref
A_0
(unsafe-fx+ Alo_0 i_0))))
(letrec*
((jloop_0
(|#%name|
jloop
(lambda (j_0)
(begin
(let ((ref-j-1_0
(unsafe-vector-ref
A_0
(unsafe-fx-
j_0
1))))
(if (if (unsafe-fx<
Blo_0
j_0)
(|#%app|
less-than?_0
ref-i_0
ref-j-1_0)
#f)
(begin
(unsafe-vector-set!
A_0
j_0
ref-j-1_0)
(jloop_0
(unsafe-fx-
j_0
1)))
(begin
(unsafe-vector-set!
A_0
j_0
ref-i_0)
(iloop_0
(unsafe-fx+
i_0
1))))))))))
(jloop_0
(unsafe-fx+ Blo_0 i_0))))
(void)))))))
(iloop_0 1)))
(let ((n/2-_1 (unsafe-fxrshift n_1 1)))
(let ((n/2+_1 (unsafe-fx- n_1 n/2-_1)))
(let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1)))
(let ((Amid2_0 (unsafe-fx+ Alo_0 n/2+_1)))
(let ((Bmid1_0
(unsafe-fx+ Blo_0 n/2-_1)))
(begin
(copying-mergesort_0
Amid1_0
Bmid1_0
n/2+_1)
(copying-mergesort_0
Alo_0
Amid2_0
n/2-_1)
(let ((b2_0 (unsafe-fx+ Blo_0 n_1)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (a1_0 b1_0 c1_0)
(begin
(let ((x_0
(unsafe-vector-ref
A_0
a1_0)))
(let ((y_0
(unsafe-vector-ref
A_0
b1_0)))
(let ((x_1 x_0))
(if (not
(|#%app|
less-than?_0
y_0
x_1))
(begin
(unsafe-vector-set!
A_0
c1_0
x_1)
(let ((a1_1
(unsafe-fx+
a1_0
1)))
(let ((c1_1
(unsafe-fx+
c1_0
1)))
(if (unsafe-fx<
c1_1
b1_0)
(loop_0
a1_1
b1_0
c1_1)
(void)))))
(begin
(unsafe-vector-set!
A_0
c1_0
y_0)
(let ((b1_1
(unsafe-fx+
b1_0
1)))
(let ((c1_1
(unsafe-fx+
c1_0
1)))
(if (unsafe-fx<=
b2_0
b1_1)
(letrec*
((loop_1
(|#%name|
loop
(lambda (a1_1
c1_2)
(begin
(if (unsafe-fx<
c1_2
b1_1)
(begin
(unsafe-vector-set!
A_0
c1_2
(unsafe-vector-ref
A_0
a1_1))
(loop_1
(unsafe-fx+
a1_1
1)
(unsafe-fx+
c1_2
1)))
(void)))))))
(loop_1
a1_0
c1_1))
(loop_0
a1_0
b1_1
c1_1))))))))))))))
(loop_0
Amid2_0
Bmid1_0
Blo_0)))))))))))))))))
(begin
(copying-mergesort_0 n/2-_0 n_0 n/2+_0)
(if (zero? n/2-_0)
(void)
(copying-mergesort_0 0 n/2+_0 n/2-_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (a1_0 b1_0 c1_0)
(begin
(let ((x_0 (unsafe-vector-ref A_0 a1_0)))
(let ((y_0 (unsafe-vector-ref A_0 b1_0)))
(let ((x_1 x_0))
(if (|#%app| less-than?_0 x_1 y_0)
(begin
(unsafe-vector-set! A_0 c1_0 x_1)
(let ((a1_1 (unsafe-fx+ a1_0 1)))
(let ((c1_1 (unsafe-fx+ c1_0 1)))
(if (unsafe-fx< c1_1 b1_0)
(loop_0 a1_1 b1_0 c1_1)
(void)))))
(begin
(unsafe-vector-set! A_0 c1_0 y_0)
(let ((b1_1 (unsafe-fx+ b1_0 1)))
(let ((c1_1 (unsafe-fx+ c1_0 1)))
(if (unsafe-fx<= n_0 b1_1)
(letrec*
((loop_1
(|#%name|
loop
(lambda (a1_1 c1_2)
(begin
(if (unsafe-fx< c1_2 b1_1)
(begin
(unsafe-vector-set!
A_0
c1_2
(unsafe-vector-ref
A_0
a1_1))
(loop_1
(unsafe-fx+ a1_1 1)
(unsafe-fx+ c1_2 1)))
(void)))))))
(loop_1 a1_0 c1_1))
(loop_0
a1_0
b1_1
c1_1))))))))))))))
(loop_0 n_0 n/2+_0 0)))))))))))
(let ((generic-sort/key_0
(|#%name|
generic-sort/key
(lambda (A_0 less-than?_0 n_0 key_0)
(begin
(let ((n/2-_0 (unsafe-fxrshift n_0 1)))
(let ((n/2+_0 (unsafe-fx- n_0 n/2-_0)))
(letrec*
((copying-mergesort_0
(|#%name|
copying-mergesort
(lambda (Alo_0 Blo_0 n_1)
(begin
(if (unsafe-fx= n_1 1)
(unsafe-vector-set!
A_0
Blo_0
(unsafe-vector-ref A_0 Alo_0))
(if (unsafe-fx= n_1 2)
(let ((x_0 (unsafe-vector-ref A_0 Alo_0)))
(let ((y_0
(unsafe-vector-ref
A_0
(unsafe-fx+ Alo_0 1))))
(let ((x_1 x_0))
(if (if key_0
(let ((app_0 (|#%app| key_0 y_0)))
(|#%app|
less-than?_0
app_0
(|#%app| key_0 x_1)))
(|#%app| less-than?_0 y_0 x_1))
(begin
(unsafe-vector-set! A_0 Blo_0 y_0)
(unsafe-vector-set!
A_0
(unsafe-fx+ Blo_0 1)
x_1))
(begin
(unsafe-vector-set! A_0 Blo_0 x_1)
(unsafe-vector-set!
A_0
(unsafe-fx+ Blo_0 1)
y_0))))))
(if (unsafe-fx< n_1 16)
(begin
(unsafe-vector-set!
A_0
Blo_0
(unsafe-vector-ref A_0 Alo_0))
(letrec*
((iloop_0
(|#%name|
iloop
(lambda (i_0)
(begin
(if (unsafe-fx< i_0 n_1)
(let ((ref-i_0
(unsafe-vector-ref
A_0
(unsafe-fx+ Alo_0 i_0))))
(letrec*
((jloop_0
(|#%name|
jloop
(lambda (j_0)
(begin
(let ((ref-j-1_0
(unsafe-vector-ref
A_0
(unsafe-fx-
j_0
1))))
(if (if (unsafe-fx<
Blo_0
j_0)
(if key_0
(let ((app_0
(|#%app|
key_0
ref-i_0)))
(|#%app|
less-than?_0
app_0
(|#%app|
key_0
ref-j-1_0)))
(|#%app|
less-than?_0
ref-i_0
ref-j-1_0))
#f)
(begin
(unsafe-vector-set!
A_0
j_0
ref-j-1_0)
(jloop_0
(unsafe-fx-
j_0
1)))
(begin
(unsafe-vector-set!
A_0
j_0
ref-i_0)
(iloop_0
(unsafe-fx+
i_0
1))))))))))
(jloop_0
(unsafe-fx+ Blo_0 i_0))))
(void)))))))
(iloop_0 1)))
(let ((n/2-_1 (unsafe-fxrshift n_1 1)))
(let ((n/2+_1 (unsafe-fx- n_1 n/2-_1)))
(let ((Amid1_0 (unsafe-fx+ Alo_0 n/2-_1)))
(let ((Amid2_0
(unsafe-fx+ Alo_0 n/2+_1)))
(let ((Bmid1_0
(unsafe-fx+ Blo_0 n/2-_1)))
(begin
(copying-mergesort_0
Amid1_0
Bmid1_0
n/2+_1)
(copying-mergesort_0
Alo_0
Amid2_0
n/2-_1)
(let ((b2_0
(unsafe-fx+ Blo_0 n_1)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (a1_0 b1_0 c1_0)
(begin
(let ((x_0
(unsafe-vector-ref
A_0
a1_0)))
(let ((y_0
(unsafe-vector-ref
A_0
b1_0)))
(let ((x_1 x_0))
(if (not
(if key_0
(let ((app_0
(|#%app|
key_0
y_0)))
(|#%app|
less-than?_0
app_0
(|#%app|
key_0
x_1)))
(|#%app|
less-than?_0
y_0
x_1)))
(begin
(unsafe-vector-set!
A_0
c1_0
x_1)
(let ((a1_1
(unsafe-fx+
a1_0
1)))
(let ((c1_1
(unsafe-fx+
c1_0
1)))
(if (unsafe-fx<
c1_1
b1_0)
(loop_0
a1_1
b1_0
c1_1)
(void)))))
(begin
(unsafe-vector-set!
A_0
c1_0
y_0)
(let ((b1_1
(unsafe-fx+
b1_0
1)))
(let ((c1_1
(unsafe-fx+
c1_0
1)))
(if (unsafe-fx<=
b2_0
b1_1)
(letrec*
((loop_1
(|#%name|
loop
(lambda (a1_1
c1_2)
(begin
(if (unsafe-fx<
c1_2
b1_1)
(begin
(unsafe-vector-set!
A_0
c1_2
(unsafe-vector-ref
A_0
a1_1))
(loop_1
(unsafe-fx+
a1_1
1)
(unsafe-fx+
c1_2
1)))
(void)))))))
(loop_1
a1_0
c1_1))
(loop_0
a1_0
b1_1
c1_1))))))))))))))
(loop_0
Amid2_0
Bmid1_0
Blo_0)))))))))))))))))
(begin
(copying-mergesort_0 n/2-_0 n_0 n/2+_0)
(if (zero? n/2-_0)
(void)
(copying-mergesort_0 0 n/2+_0 n/2-_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (a1_0 b1_0 c1_0)
(begin
(let ((x_0 (unsafe-vector-ref A_0 a1_0)))
(let ((y_0 (unsafe-vector-ref A_0 b1_0)))
(let ((x_1 x_0))
(if (if key_0
(let ((app_0 (|#%app| key_0 x_1)))
(|#%app|
less-than?_0
app_0
(|#%app| key_0 y_0)))
(|#%app| less-than?_0 x_1 y_0))
(begin
(unsafe-vector-set! A_0 c1_0 x_1)
(let ((a1_1 (unsafe-fx+ a1_0 1)))
(let ((c1_1 (unsafe-fx+ c1_0 1)))
(if (unsafe-fx< c1_1 b1_0)
(loop_0 a1_1 b1_0 c1_1)
(void)))))
(begin
(unsafe-vector-set! A_0 c1_0 y_0)
(let ((b1_1 (unsafe-fx+ b1_0 1)))
(let ((c1_1 (unsafe-fx+ c1_0 1)))
(if (unsafe-fx<= n_0 b1_1)
(letrec*
((loop_1
(|#%name|
loop
(lambda (a1_1 c1_2)
(begin
(if (unsafe-fx<
c1_2
b1_1)
(begin
(unsafe-vector-set!
A_0
c1_2
(unsafe-vector-ref
A_0
a1_1))
(loop_1
(unsafe-fx+ a1_1 1)
(unsafe-fx+
c1_2
1)))
(void)))))))
(loop_1 a1_0 c1_1))
(loop_0
a1_0
b1_1
c1_1))))))))))))))
(loop_0 n_0 n/2+_0 0)))))))))))
(values
(case-lambda
((lst_0 less-than?_0)
(let ((n_0 (length lst_0)))
(if (unsafe-fx= n_0 0)
lst_0
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (last_0 next_0)
(begin
(let ((or-part_0 (null? next_0)))
(if or-part_0
or-part_0
(if (not
(|#%app|
less-than?_0
(unsafe-car next_0)
last_0))
(loop_0 (unsafe-car next_0) (unsafe-cdr next_0))
#f))))))))
(let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0))))
lst_0
(if (unsafe-fx<= n_0 3)
(if (unsafe-fx= n_0 1)
lst_0
(if (unsafe-fx= n_0 2)
(let ((app_0 (cadr lst_0))) (list app_0 (car lst_0)))
(let ((a_0 (car lst_0)))
(let ((b_0 (cadr lst_0)))
(let ((c_0 (caddr lst_0)))
(let ((b_1 b_0) (a_1 a_0))
(if (|#%app| less-than?_0 b_1 a_1)
(if (|#%app| less-than?_0 c_0 b_1)
(list c_0 b_1 a_1)
(if (|#%app| less-than?_0 c_0 a_1)
(list b_1 c_0 a_1)
(list b_1 a_1 c_0)))
(if (|#%app| less-than?_0 c_0 a_1)
(list c_0 a_1 b_1)
(list a_1 c_0 b_1)))))))))
(let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2))))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 lst_1)
(begin
(if (pair? lst_1)
(begin
(vector-set! vec_0 i_0 (car lst_1))
(let ((app_0 (add1 i_0)))
(loop_0 app_0 (cdr lst_1))))
(void)))))))
(loop_0 0 lst_0))
(generic-sort_0 vec_0 less-than?_0 n_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 r_0)
(begin
(let ((i_1 (sub1 i_0)))
(if (< i_1 0)
r_0
(loop_0
i_1
(cons (vector-ref vec_0 i_1) r_0)))))))))
(loop_0 n_0 '())))))))))
((lst_0 less-than?_0 getkey_0)
(if (if getkey_0 (not (eq? values getkey_0)) #f)
(|#%app|
(check-not-unsafe-undefined sort 'sort)
lst_0
less-than?_0
getkey_0
#f)
(|#%app|
(check-not-unsafe-undefined sort 'sort)
lst_0
less-than?_0)))
((lst_0 less-than?_0 getkey_0 cache-keys?_0)
(if (if getkey_0 (not (eq? values getkey_0)) #f)
(let ((n_0 (length lst_0)))
(if (unsafe-fx= n_0 0)
lst_0
(if cache-keys?_0
(let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2))))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 lst_1)
(begin
(if (pair? lst_1)
(let ((x_0 (car lst_1)))
(begin
(unsafe-vector-set!
vec_0
i_0
(cons (|#%app| getkey_0 x_0) x_0))
(loop_0 (unsafe-fx+ i_0 1) (cdr lst_1))))
(void)))))))
(loop_0 0 lst_0))
(generic-sort/key_0 vec_0 less-than?_0 n_0 unsafe-car)
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 r_0)
(begin
(let ((i_1 (unsafe-fx- i_0 1)))
(if (unsafe-fx< i_1 0)
r_0
(loop_0
i_1
(cons
(unsafe-cdr (unsafe-vector-ref vec_0 i_1))
r_0)))))))))
(loop_0 n_0 '()))))
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (last_0 next_0)
(begin
(let ((or-part_0 (null? next_0)))
(if or-part_0
or-part_0
(if (not
(if getkey_0
(let ((app_0
(|#%app|
getkey_0
(unsafe-car next_0))))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 last_0)))
(|#%app|
less-than?_0
(unsafe-car next_0)
last_0)))
(loop_0
(unsafe-car next_0)
(unsafe-cdr next_0))
#f))))))))
(let ((app_0 (car lst_0))) (loop_0 app_0 (cdr lst_0))))
lst_0
(if (unsafe-fx<= n_0 3)
(if (unsafe-fx= n_0 1)
lst_0
(if (unsafe-fx= n_0 2)
(let ((app_0 (cadr lst_0))) (list app_0 (car lst_0)))
(let ((a_0 (car lst_0)))
(let ((b_0 (cadr lst_0)))
(let ((c_0 (caddr lst_0)))
(let ((b_1 b_0) (a_1 a_0))
(if (if getkey_0
(let ((app_0 (|#%app| getkey_0 b_1)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 b_1 a_1))
(if (if getkey_0
(let ((app_0 (|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 b_1)))
(|#%app| less-than?_0 c_0 b_1))
(list c_0 b_1 a_1)
(if (if getkey_0
(let ((app_0 (|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 c_0 a_1))
(list b_1 c_0 a_1)
(list b_1 a_1 c_0)))
(if (if getkey_0
(let ((app_0 (|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 c_0 a_1))
(list c_0 a_1 b_1)
(list a_1 c_0 b_1)))))))))
(let ((vec_0 (make-vector (+ n_0 (ceiling (/ n_0 2))))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 lst_1)
(begin
(if (pair? lst_1)
(begin
(vector-set! vec_0 i_0 (car lst_1))
(let ((app_0 (add1 i_0)))
(loop_0 app_0 (cdr lst_1))))
(void)))))))
(loop_0 0 lst_0))
(generic-sort/key_0 vec_0 less-than?_0 n_0 getkey_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 r_0)
(begin
(let ((i_1 (sub1 i_0)))
(if (< i_1 0)
r_0
(loop_0
i_1
(cons (vector-ref vec_0 i_1) r_0)))))))))
(loop_0 n_0 '())))))))))
(|#%app|
(check-not-unsafe-undefined sort 'sort)
lst_0
less-than?_0))))
(case-lambda
((vec_0 less-than?_0 start_0 end_0)
(let ((n_0 (- end_0 start_0)))
(let ((dst-vec_0 (make-vector n_0)))
(begin
(if (unsafe-fx= n_0 0)
(void)
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (prev-val_0 next-index_0)
(begin
(let ((or-part_0 (unsafe-fx= next-index_0 end_0)))
(if or-part_0
or-part_0
(let ((next-val_0
(unsafe-vector-ref vec_0 next-index_0)))
(if (not
(|#%app|
less-than?_0
next-val_0
prev-val_0))
(loop_0
next-val_0
(unsafe-fx+ next-index_0 1))
#f)))))))))
(loop_0
(unsafe-vector-ref vec_0 start_0)
(unsafe-fx+ start_0 1)))
(vector-copy! dst-vec_0 0 vec_0 start_0 end_0)
(if (unsafe-fx<= n_0 3)
(begin
(vector-copy! dst-vec_0 0 vec_0 start_0 end_0)
(if (unsafe-fx= n_0 1)
(void)
(if (unsafe-fx= n_0 2)
(let ((tmp_0 (unsafe-vector-ref dst-vec_0 0)))
(begin
(unsafe-vector-set!
dst-vec_0
0
(unsafe-vector-ref dst-vec_0 1))
(unsafe-vector-set! dst-vec_0 1 tmp_0)))
(let ((a_0 (unsafe-vector-ref dst-vec_0 0)))
(let ((b_0 (unsafe-vector-ref dst-vec_0 1)))
(let ((c_0 (unsafe-vector-ref dst-vec_0 2)))
(let ((b_1 b_0) (a_1 a_0))
(if (|#%app| less-than?_0 b_1 a_1)
(if (|#%app| less-than?_0 c_0 b_1)
(begin
(unsafe-vector-set! dst-vec_0 0 c_0)
(unsafe-vector-set! dst-vec_0 2 a_1))
(if (|#%app| less-than?_0 c_0 a_1)
(begin
(unsafe-vector-set! dst-vec_0 0 b_1)
(unsafe-vector-set! dst-vec_0 1 c_0)
(unsafe-vector-set! dst-vec_0 2 a_1))
(begin
(unsafe-vector-set! dst-vec_0 0 b_1)
(unsafe-vector-set!
dst-vec_0
1
a_1))))
(if (|#%app| less-than?_0 c_0 a_1)
(begin
(unsafe-vector-set! dst-vec_0 0 c_0)
(unsafe-vector-set! dst-vec_0 1 a_1)
(unsafe-vector-set! dst-vec_0 2 b_1))
(begin
(unsafe-vector-set! dst-vec_0 1 c_0)
(unsafe-vector-set!
dst-vec_0
2
b_1)))))))))))
(let ((work-vec_0
(make-vector (+ n_0 (ceiling (/ n_0 2))) #f)))
(begin
(vector-copy! work-vec_0 0 vec_0 start_0 end_0)
(generic-sort_0 work-vec_0 less-than?_0 n_0)
(vector-copy! dst-vec_0 0 work-vec_0 0 n_0))))))
dst-vec_0))))
((vec_0 less-than?_0 start_0 end_0 getkey_0 cache-keys?_0)
(if (if getkey_0 (not (eq? values getkey_0)) #f)
(let ((n_0 (- end_0 start_0)))
(let ((dst-vec_0 (make-vector n_0)))
(begin
(if (unsafe-fx= n_0 0)
(void)
(if cache-keys?_0
(let ((work-vec_0
(make-vector (+ n_0 (ceiling (/ n_0 2))) #t)))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (unsafe-fx< i_0 n_0)
(begin
(let ((x_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ i_0 start_0))))
(unsafe-vector-set!
work-vec_0
i_0
(cons (|#%app| getkey_0 x_0) x_0)))
(loop_0 (unsafe-fx+ i_0 1)))
(void)))))))
(loop_0 0))
(generic-sort/key_0
work-vec_0
less-than?_0
n_0
unsafe-car)
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (unsafe-fx< i_0 n_0)
(begin
(unsafe-vector-set!
dst-vec_0
(unsafe-fx+ i_0 0)
(unsafe-cdr
(unsafe-vector-ref work-vec_0 i_0)))
(loop_0 (unsafe-fx+ i_0 1)))
(void)))))))
(loop_0 0))))
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (prev-val_0 next-index_0)
(begin
(let ((or-part_0
(unsafe-fx= next-index_0 end_0)))
(if or-part_0
or-part_0
(let ((next-val_0
(unsafe-vector-ref
vec_0
next-index_0)))
(if (not
(if getkey_0
(let ((app_0
(|#%app|
getkey_0
next-val_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 prev-val_0)))
(|#%app|
less-than?_0
next-val_0
prev-val_0)))
(loop_0
next-val_0
(unsafe-fx+ next-index_0 1))
#f)))))))))
(loop_0
(unsafe-vector-ref vec_0 start_0)
(unsafe-fx+ start_0 1)))
(vector-copy! dst-vec_0 0 vec_0 start_0 end_0)
(if (unsafe-fx<= n_0 3)
(begin
(vector-copy! dst-vec_0 0 vec_0 start_0 end_0)
(if (unsafe-fx= n_0 1)
(void)
(if (unsafe-fx= n_0 2)
(let ((tmp_0 (unsafe-vector-ref dst-vec_0 0)))
(begin
(unsafe-vector-set!
dst-vec_0
0
(unsafe-vector-ref dst-vec_0 1))
(unsafe-vector-set! dst-vec_0 1 tmp_0)))
(let ((a_0 (unsafe-vector-ref dst-vec_0 0)))
(let ((b_0 (unsafe-vector-ref dst-vec_0 1)))
(let ((c_0 (unsafe-vector-ref dst-vec_0 2)))
(let ((b_1 b_0) (a_1 a_0))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 b_1)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 b_1 a_1))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 b_1)))
(|#%app| less-than?_0 c_0 b_1))
(begin
(unsafe-vector-set!
dst-vec_0
0
c_0)
(unsafe-vector-set!
dst-vec_0
2
a_1))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 c_0 a_1))
(begin
(unsafe-vector-set!
dst-vec_0
0
b_1)
(unsafe-vector-set!
dst-vec_0
1
c_0)
(unsafe-vector-set!
dst-vec_0
2
a_1))
(begin
(unsafe-vector-set!
dst-vec_0
0
b_1)
(unsafe-vector-set!
dst-vec_0
1
a_1))))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 c_0 a_1))
(begin
(unsafe-vector-set!
dst-vec_0
0
c_0)
(unsafe-vector-set!
dst-vec_0
1
a_1)
(unsafe-vector-set!
dst-vec_0
2
b_1))
(begin
(unsafe-vector-set!
dst-vec_0
1
c_0)
(unsafe-vector-set!
dst-vec_0
2
b_1)))))))))))
(let ((work-vec_0
(make-vector (+ n_0 (ceiling (/ n_0 2))) #f)))
(begin
(vector-copy! work-vec_0 0 vec_0 start_0 end_0)
(generic-sort/key_0
work-vec_0
less-than?_0
n_0
getkey_0)
(vector-copy! dst-vec_0 0 work-vec_0 0 n_0)))))))
dst-vec_0)))
(|#%app|
(check-not-unsafe-undefined vector-sort 'vector-sort)
vec_0
less-than?_0
start_0
end_0))))
(case-lambda
((vec_0 less-than?_0 start_0 end_0)
(let ((n_0 (- end_0 start_0)))
(begin
(if (unsafe-fx= n_0 0)
(void)
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (prev-val_0 next-index_0)
(begin
(let ((or-part_0 (unsafe-fx= next-index_0 end_0)))
(if or-part_0
or-part_0
(let ((next-val_0
(unsafe-vector-ref vec_0 next-index_0)))
(if (not
(|#%app|
less-than?_0
next-val_0
prev-val_0))
(loop_0
next-val_0
(unsafe-fx+ next-index_0 1))
#f)))))))))
(loop_0
(unsafe-vector-ref vec_0 start_0)
(unsafe-fx+ start_0 1)))
(void)
(if (unsafe-fx<= n_0 3)
(begin
(if (unsafe-fx= n_0 1)
(void)
(if (unsafe-fx= n_0 2)
(let ((tmp_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 0))))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
(unsafe-vector-ref vec_0 (unsafe-fx+ start_0 1)))
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
tmp_0)))
(let ((a_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 0))))
(let ((b_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 1))))
(let ((c_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 2))))
(let ((b_1 b_0) (a_1 a_0))
(if (|#%app| less-than?_0 b_1 a_1)
(if (|#%app| less-than?_0 c_0 b_1)
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
a_1))
(if (|#%app| less-than?_0 c_0 a_1)
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
b_1)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
a_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
b_1)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
a_1))))
(if (|#%app| less-than?_0 c_0 a_1)
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
a_1)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
b_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
b_1)))))))))))
(let ((work-vec_0
(make-vector (+ n_0 (ceiling (/ n_0 2))) #f)))
(begin
(vector-copy! work-vec_0 0 vec_0 start_0 end_0)
(generic-sort_0 work-vec_0 less-than?_0 n_0)
(vector-copy! vec_0 start_0 work-vec_0 0 n_0))))))
(void))))
((vec_0 less-than?_0 start_0 end_0 getkey_0 cache-keys?_0)
(if (if getkey_0 (not (eq? values getkey_0)) #f)
(let ((n_0 (- end_0 start_0)))
(begin
(if (unsafe-fx= n_0 0)
(void)
(if cache-keys?_0
(let ((work-vec_0
(make-vector (+ n_0 (ceiling (/ n_0 2))) #t)))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (unsafe-fx< i_0 n_0)
(begin
(let ((x_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ i_0 start_0))))
(unsafe-vector-set!
work-vec_0
i_0
(cons (|#%app| getkey_0 x_0) x_0)))
(loop_0 (unsafe-fx+ i_0 1)))
(void)))))))
(loop_0 0))
(generic-sort/key_0
work-vec_0
less-than?_0
n_0
unsafe-car)
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (unsafe-fx< i_0 n_0)
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ i_0 start_0)
(unsafe-cdr
(unsafe-vector-ref work-vec_0 i_0)))
(loop_0 (unsafe-fx+ i_0 1)))
(void)))))))
(loop_0 0))))
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (prev-val_0 next-index_0)
(begin
(let ((or-part_0
(unsafe-fx= next-index_0 end_0)))
(if or-part_0
or-part_0
(let ((next-val_0
(unsafe-vector-ref
vec_0
next-index_0)))
(if (not
(if getkey_0
(let ((app_0
(|#%app|
getkey_0
next-val_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 prev-val_0)))
(|#%app|
less-than?_0
next-val_0
prev-val_0)))
(loop_0
next-val_0
(unsafe-fx+ next-index_0 1))
#f)))))))))
(loop_0
(unsafe-vector-ref vec_0 start_0)
(unsafe-fx+ start_0 1)))
(void)
(if (unsafe-fx<= n_0 3)
(begin
(if (unsafe-fx= n_0 1)
(void)
(if (unsafe-fx= n_0 2)
(let ((tmp_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 0))))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 1)))
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
tmp_0)))
(let ((a_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 0))))
(let ((b_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 1))))
(let ((c_0
(unsafe-vector-ref
vec_0
(unsafe-fx+ start_0 2))))
(let ((b_1 b_0) (a_1 a_0))
(if (if getkey_0
(let ((app_0 (|#%app| getkey_0 b_1)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 b_1 a_1))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 b_1)))
(|#%app| less-than?_0 c_0 b_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
a_1))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 c_0 a_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
b_1)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
a_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
b_1)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
a_1))))
(if (if getkey_0
(let ((app_0
(|#%app| getkey_0 c_0)))
(|#%app|
less-than?_0
app_0
(|#%app| getkey_0 a_1)))
(|#%app| less-than?_0 c_0 a_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 0)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
a_1)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
b_1))
(begin
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 1)
c_0)
(unsafe-vector-set!
vec_0
(unsafe-fx+ start_0 2)
b_1)))))))))))
(let ((work-vec_0
(make-vector (+ n_0 (ceiling (/ n_0 2))) #f)))
(begin
(vector-copy! work-vec_0 0 vec_0 start_0 end_0)
(generic-sort/key_0
work-vec_0
less-than?_0
n_0
getkey_0)
(vector-copy! vec_0 start_0 work-vec_0 0 n_0)))))))
(void)))
(|#%app|
(check-not-unsafe-undefined vector-sort! 'vector-sort!)
vec_0
less-than?_0
start_0
end_0))))))))
(define-values
(prop:stream stream-via-prop? stream-ref)
(make-struct-type-property
'stream
(lambda (v_0 si_0)
(begin
(if (if (vector? v_0)
(if (= 3 (vector-length v_0))
(if (procedure? (vector-ref v_0 0))
(if (procedure-arity-includes? (vector-ref v_0 0) 1)
(if (procedure? (vector-ref v_0 1))
(if (procedure-arity-includes? (vector-ref v_0 1) 1)
(if (procedure? (vector-ref v_0 2))
(procedure-arity-includes? (vector-ref v_0 2) 1)
#f)
#f)
#f)
#f)
#f)
#f)
#f)
(void)
(raise-argument-error
'guard-for-prop:stream
(string-append
"(vector/c (procedure-arity-includes/c 1)\n"
" (procedure-arity-includes/c 1)\n"
" (procedure-arity-includes/c 1))")
v_0))
(vector->immutable-vector v_0)))
'()
#t))
(define-values
(prop:gen-sequence sequence-via-prop? sequence-ref)
(make-struct-type-property
'sequence
(lambda (v_0 si_0)
(begin
(if (if (procedure? v_0) (procedure-arity-includes? v_0 1) #f)
(void)
(raise-argument-error
'guard-for-prop:sequence
"(procedure-arity-includes/c 1)"
v_0))
v_0))))
(define-values
(struct:range make-range range? range-ref range-set!)
(make-struct-type
'stream
#f
3
0
#f
(list
(cons
prop:stream
(vector
(lambda (v_0)
(let ((cont?_0 (|#%app| range-ref v_0 2)))
(if cont?_0 (not (|#%app| cont?_0 (|#%app| range-ref v_0 0))) #f)))
(lambda (v_0) (|#%app| range-ref v_0 0))
(lambda (v_0)
(let ((app_0
(let ((app_0 (|#%app| range-ref v_0 1)))
(|#%app| app_0 (|#%app| range-ref v_0 0)))))
(let ((app_1 (|#%app| range-ref v_0 1)))
(make-range app_0 app_1 (|#%app| range-ref v_0 2)))))))
(cons
prop:gen-sequence
(lambda (v_0)
(let ((app_0 (|#%app| range-ref v_0 1)))
(let ((app_1 (|#%app| range-ref v_0 0)))
(values values #f app_0 app_1 (|#%app| range-ref v_0 2) #f #f))))))))
(define check-range
(lambda (a_0 b_0 step_0)
(begin
(if (real? a_0) (void) (raise-argument-error 'in-range "real?" a_0))
(if (real? b_0) (void) (raise-argument-error 'in-range "real?" b_0))
(if (real? step_0)
(void)
(raise-argument-error 'in-range "real?" step_0)))))
(define check-naturals
(lambda (n_0)
(if (if (integer? n_0) (if (exact? n_0) (>= n_0 0) #f) #f)
(void)
(raise-argument-error 'in-naturals "exact-nonnegative-integer?" n_0))))
(define-values
(struct:list-stream
make-list-stream
list-stream?
list-stream-ref
list-stream-set!)
(make-struct-type
'stream
#f
1
0
#f
(list
(cons
prop:stream
(vector
(lambda (v_0) (not (pair? (|#%app| list-stream-ref v_0 0))))
(lambda (v_0) (car (|#%app| list-stream-ref v_0 0)))
(lambda (v_0) (make-list-stream (cdr (|#%app| list-stream-ref v_0 0))))))
(cons
prop:gen-sequence
(lambda (v_0)
(values car cdr values (|#%app| list-stream-ref v_0 0) pair? #f #f))))))
(define check-list
(lambda (l_0)
(if (list? l_0) (void) (raise-argument-error 'in-list "list?" l_0))))
(define check-in-hash
(lambda (ht_0)
(if (hash? ht_0) (void) (raise-argument-error 'in-hash "hash?" ht_0))))
(define check-in-immutable-hash
(lambda (ht_0)
(if (if (hash? ht_0) (immutable? ht_0) #f)
(void)
(raise-argument-error
'in-immutable-hash
"(and/c hash? immutable?)"
ht_0))))
(define check-in-hash-keys
(lambda (ht_0)
(if (hash? ht_0)
(void)
(raise-argument-error 'in-hash-keys "hash?" ht_0))))
(define check-in-immutable-hash-keys
(lambda (ht_0)
(if (if (hash? ht_0) (immutable? ht_0) #f)
(void)
(raise-argument-error
'in-immutable-hash-keys
"(and/c hash? immutable?)"
ht_0))))
(define check-in-hash-values
(lambda (ht_0)
(if (hash? ht_0)
(void)
(raise-argument-error 'in-hash-values "hash?" ht_0))))
(define check-ranges
(lambda (who_0 type-name_0 vec_0 start_0 stop_0 step_0 len_0)
(begin
(if (if (exact-nonnegative-integer? start_0)
(let ((or-part_0 (< start_0 len_0)))
(if or-part_0 or-part_0 (= len_0 start_0 stop_0)))
#f)
(void)
(raise-range-error
who_0
type-name_0
"starting "
start_0
vec_0
0
(sub1 len_0)))
(if (if (exact-integer? stop_0)
(if (<= -1 stop_0) (<= stop_0 len_0) #f)
#f)
(void)
(raise-range-error
who_0
type-name_0
"stopping "
stop_0
vec_0
-1
len_0))
(if (if (exact-integer? step_0) (not (zero? step_0)) #f)
(void)
(raise-argument-error
who_0
"(and/c exact-integer? (not/c zero?))"
step_0))
(if (if (< start_0 stop_0) (< step_0 0) #f)
(raise-arguments-error
who_0
"starting index less than stopping index, but given a negative step"
"starting index"
start_0
"stopping index"
stop_0
"step"
step_0)
(void))
(if (if (< stop_0 start_0) (> step_0 0) #f)
(raise-arguments-error
who_0
"starting index more than stopping index, but given a positive step"
"starting index"
start_0
"stopping index"
stop_0
"step"
step_0)
(void)))))
(define normalise-inputs
(lambda (who_0
type-name_0
vector?_0
unsafe-vector-length_0
vec_0
start_0
stop_0
step_0)
(begin
(if (|#%app| vector?_0 vec_0)
(void)
(raise-argument-error who_0 type-name_0 vec_0))
(let ((len_0 (|#%app| unsafe-vector-length_0 vec_0)))
(let ((stop*_0 (if stop_0 stop_0 len_0)))
(begin
(check-ranges who_0 type-name_0 vec_0 start_0 stop*_0 step_0 len_0)
(values vec_0 start_0 stop*_0 step_0)))))))
(define unsafe-normalise-inputs
(lambda (unsafe-vector-length_0 vec_0 start_0 stop_0 step_0)
(values
vec_0
start_0
(if stop_0 stop_0 (|#%app| unsafe-vector-length_0 vec_0))
step_0)))
(define check-vector
(lambda (v_0)
(if (vector? v_0) (void) (raise-argument-error 'in-vector "vector" v_0))))
(define check-string
(lambda (v_0)
(if (string? v_0) (void) (raise-argument-error 'in-string "string" v_0))))
(define check-bytes
(lambda (v_0)
(if (bytes? v_0) (void) (raise-argument-error 'in-bytes "bytes" v_0))))
(define-values
(struct:do-stream make-do-stream do-stream? do-stream-ref do-stream-set!)
(make-struct-type
'stream
#f
3
0
#f
(list
(cons
prop:stream
(vector
(lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 0)))
(lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 1)))
(lambda (v_0) (|#%app| (|#%app| do-stream-ref v_0 2))))))))
(define empty-stream (make-do-stream (lambda () #t) void void))
(define grow-vector
(lambda (vec_0)
(let ((n_0 (vector-length vec_0)))
(let ((new-vec_0 (make-vector (* 2 n_0))))
(begin (vector-copy! new-vec_0 0 vec_0 0 n_0) new-vec_0)))))
(define shrink-vector
(lambda (vec_0 i_0)
(let ((new-vec_0 (make-vector i_0)))
(begin (vector-copy! new-vec_0 0 vec_0 0 i_0) new-vec_0))))
(define map_1346
(|#%name|
map
(case-lambda
((f_0 l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? l_1)
null
(let ((r_0 (cdr l_1)))
(let ((app_0 (|#%app| f_0 (car l_1))))
(cons app_0 (loop_0 r_0))))))))))
(loop_0 l_0))))
((f_0 l1_0 l2_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (l1_1 l2_1)
(begin
(if (null? l1_1)
null
(let ((r1_0 (cdr l1_1)))
(let ((r2_0 (cdr l2_1)))
(let ((r1_1 r1_0))
(let ((app_0
(let ((app_0 (car l1_1)))
(|#%app| f_0 app_0 (car l2_1)))))
(cons app_0 (loop_0 r1_1 r2_0))))))))))))
(loop_0 l1_0 l2_0)))
((f_0 l_0 . args_0) (gen-map f_0 (cons l_0 args_0))))))
(define for-each_2380
(|#%name|
for-each
(case-lambda
((f_0 l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? l_1)
(void)
(let ((r_0 (cdr l_1)))
(begin (|#%app| f_0 (car l_1)) (loop_0 r_0)))))))))
(loop_0 l_0))))
((f_0 l1_0 l2_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (l1_1 l2_1)
(begin
(if (null? l1_1)
(void)
(let ((r1_0 (cdr l1_1)))
(let ((r2_0 (cdr l2_1)))
(let ((r1_1 r1_0))
(begin
(let ((app_0 (car l1_1)))
(|#%app| f_0 app_0 (car l2_1)))
(loop_0 r1_1 r2_0)))))))))))
(loop_0 l1_0 l2_0)))
((f_0 l_0 . args_0) (gen-for-each f_0 (cons l_0 args_0))))))
(define andmap_2344
(|#%name|
andmap
(case-lambda
((f_0 l_0)
(begin
(if (null? l_0)
#t
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? (cdr l_1))
(|#%app| f_0 (car l_1))
(let ((r_0 (cdr l_1)))
(if (|#%app| f_0 (car l_1)) (loop_0 r_0) #f))))))))
(loop_0 l_0)))))
((f_0 l1_0 l2_0)
(if (null? l1_0)
#t
(letrec*
((loop_0
(|#%name|
loop
(lambda (l1_1 l2_1)
(begin
(if (null? (cdr l1_1))
(let ((app_0 (car l1_1))) (|#%app| f_0 app_0 (car l2_1)))
(let ((r1_0 (cdr l1_1)))
(let ((r2_0 (cdr l2_1)))
(let ((r1_1 r1_0))
(if (let ((app_0 (car l1_1)))
(|#%app| f_0 app_0 (car l2_1)))
(loop_0 r1_1 r2_0)
#f))))))))))
(loop_0 l1_0 l2_0))))
((f_0 l_0 . args_0) (gen-andmap f_0 (cons l_0 args_0))))))
(define ormap_2765
(|#%name|
ormap
(case-lambda
((f_0 l_0)
(begin
(if (null? l_0)
#f
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? (cdr l_1))
(|#%app| f_0 (car l_1))
(let ((r_0 (cdr l_1)))
(let ((or-part_0 (|#%app| f_0 (car l_1))))
(if or-part_0 or-part_0 (loop_0 r_0))))))))))
(loop_0 l_0)))))
((f_0 l1_0 l2_0)
(if (null? l1_0)
#f
(letrec*
((loop_0
(|#%name|
loop
(lambda (l1_1 l2_1)
(begin
(if (null? (cdr l1_1))
(let ((app_0 (car l1_1))) (|#%app| f_0 app_0 (car l2_1)))
(let ((r1_0 (cdr l1_1)))
(let ((r2_0 (cdr l2_1)))
(let ((r1_1 r1_0))
(let ((or-part_0
(let ((app_0 (car l1_1)))
(|#%app| f_0 app_0 (car l2_1)))))
(if or-part_0 or-part_0 (loop_0 r1_1 r2_0))))))))))))
(loop_0 l1_0 l2_0))))
((f_0 l_0 . args_0) (gen-ormap f_0 (cons l_0 args_0))))))
(define check-args
(lambda (who_0 f_0 ls_0)
(begin
(if (procedure? f_0)
(void)
(raise-argument-error who_0 "procedure?" f_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (prev-len_0 ls_1 i_0)
(begin
(if (null? ls_1)
(void)
(let ((l_0 (car ls_1)))
(begin
(if (list? l_0)
(void)
(raise-argument-error who_0 "list?" l_0))
(let ((len_0 (length l_0)))
(begin
(if (if prev-len_0 (not (= len_0 prev-len_0)) #f)
(raise-arguments-error
who_0
"all lists must have same size"
"first list length"
prev-len_0
"other list length"
len_0
"procedure"
f_0)
(void))
(let ((app_0 (cdr ls_1)))
(loop_0 len_0 app_0 (add1 i_0)))))))))))))
(loop_0 #f ls_0 1))
(if (procedure-arity-includes? f_0 (length ls_0))
(void)
(call-with-values
(lambda () (procedure-keywords f_0))
(case-lambda
((required-keywords_0 optional-keywords_0)
(let ((app_0
(if (pair? required-keywords_0)
(string-append
"argument mismatch;\n"
" the given procedure expects keyword arguments")
(string-append
"argument mismatch;\n"
" the given procedure's expected number of arguments does not match"
" the given number of lists"))))
(let ((app_1
(unquoted-printing-string
(let ((or-part_0
(let ((n_0 (object-name f_0)))
(if (symbol? n_0) (symbol->string n_0) #f))))
(if or-part_0 or-part_0 "#<procedure>")))))
(apply
raise-arguments-error
who_0
app_0
"given procedure"
app_1
(let ((app_2
(let ((a_0 (procedure-arity f_0)))
(if (pair? required-keywords_0)
null
(if (integer? a_0)
(list "expected" a_0)
(if (arity-at-least? a_0)
(list
"expected"
(unquoted-printing-string
(string-append
"at least "
(number->string
(arity-at-least-value a_0)))))
null))))))
(let ((app_3
(if (pair? required-keywords_0)
null
(list "given" (length ls_0)))))
(let ((app_4
(if (pair? required-keywords_0)
(list
"required keywords"
(unquoted-printing-string
(apply
string-append
(cdr
(letrec*
((loop_0
(|#%name|
loop
(lambda (kws_0)
(begin
(if (null? kws_0)
null
(let ((app_4
(string-append
"#:"
(keyword->string
(car kws_0)))))
(list*
" "
app_4
(loop_0 (cdr kws_0))))))))))
(loop_0 required-keywords_0))))))
null)))
(append
app_2
app_3
app_4
(let ((w_0
(let ((app_5 (error-print-width)))
(quotient app_5 (length ls_0)))))
(if (> w_0 10)
(list
"argument lists..."
(unquoted-printing-string
(apply
string-append
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_1)
(begin
(if (null? ls_1)
null
(let ((app_5
(string-append
"\n "
(let ((app_5
(error-value->string-handler)))
(|#%app|
app_5
(car ls_1)
w_0)))))
(cons
app_5
(loop_0 (cdr ls_1))))))))))
(loop_0 ls_0)))))
null))))))))))
(args (raise-binding-result-arity-error 2 args))))))))
(define gen-map
(lambda (f_0 ls_0)
(begin
#t
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_1)
(begin
(if (null? (car ls_1))
null
(let ((next-ls_0 (map_1346 cdr ls_1)))
(let ((app_0 (apply f_0 (map_1346 car ls_1))))
(cons app_0 (loop_0 next-ls_0))))))))))
(loop_0 ls_0)))))
(define gen-for-each
(lambda (f_0 ls_0)
(begin
#t
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_1)
(begin
(if (null? (car ls_1))
(void)
(let ((next-ls_0 (map_1346 cdr ls_1)))
(begin
(apply f_0 (map_1346 car ls_1))
(loop_0 next-ls_0)))))))))
(loop_0 ls_0)))))
(define gen-andmap
(lambda (f_0 ls_0)
(begin
#t
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_1)
(begin
(if (null? (car ls_1))
#t
(if (null? (cdar ls_1))
(apply f_0 (map_1346 car ls_1))
(let ((next-ls_0 (map_1346 cdr ls_1)))
(if (apply f_0 (map_1346 car ls_1))
(loop_0 next-ls_0)
#f)))))))))
(loop_0 ls_0)))))
(define gen-ormap
(lambda (f_0 ls_0)
(begin
#t
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_1)
(begin
(if (null? (car ls_1))
#f
(if (null? (cdar ls_1))
(apply f_0 (map_1346 car ls_1))
(let ((next-ls_0 (map_1346 cdr ls_1)))
(let ((or-part_0 (apply f_0 (map_1346 car ls_1))))
(if or-part_0 or-part_0 (loop_0 next-ls_0)))))))))))
(loop_0 ls_0)))))
(define hash-keys
(lambda (h_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (pos_0)
(begin
(if pos_0
(let ((app_0 (hash-iterate-key h_0 pos_0)))
(cons app_0 (loop_0 (hash-iterate-next h_0 pos_0))))
null))))))
(loop_0 (hash-iterate-first h_0)))))
(define sort.1
(|#%name|
sort
(lambda (cache-keys?2_0 key1_0 lst5_0 less?6_0)
(begin
(begin
(if (list? lst5_0) (void) (raise-argument-error 'sort "list?" lst5_0))
(if (if (procedure? less?6_0)
(procedure-arity-includes? less?6_0 2)
#f)
(void)
(raise-argument-error 'sort "(any/c any/c . -> . any/c)" less?6_0))
(if (if key1_0
(not
(if (procedure? key1_0)
(procedure-arity-includes? key1_0 1)
#f))
#f)
(raise-argument-error 'sort "(any/c . -> . any/c)" key1_0)
(void))
(if key1_0
(|#%app|
(check-not-unsafe-undefined sort 'sort)
lst5_0
less?6_0
key1_0
cache-keys?2_0)
(|#%app|
(check-not-unsafe-undefined sort 'sort)
lst5_0
less?6_0)))))))
(define filter
(lambda (f_0 list_0)
(begin
(if (if (procedure? f_0) (procedure-arity-includes? f_0 1) #f)
(void)
(raise-argument-error 'filter "(any/c . -> . any/c)" f_0))
(if (list? list_0) (void) (raise-argument-error 'filter "list?" list_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_0 result_0)
(begin
(if (null? l_0)
(reverse$1 result_0)
(let ((app_0 (cdr l_0)))
(loop_0
app_0
(if (|#%app| f_0 (car l_0))
(cons (car l_0) result_0)
result_0)))))))))
(loop_0 list_0 null)))))
(define binary-or-text-desc "(or/c 'binary 'text)")
(define open-input-file.1
(|#%name|
open-input-file
(lambda (for-module?2_0 mode1_0 path5_0)
(begin
(begin
(if (path-string? path5_0)
(void)
(raise-argument-error 'open-input-file "path-string?" path5_0))
(if (memq mode1_0 '(binary text))
(void)
(raise-argument-error 'open-input-file binary-or-text-desc mode1_0))
(open-input-file
path5_0
mode1_0
(if for-module?2_0 'module 'none)))))))
(define with-input-from-file.1
(|#%name|
with-input-from-file
(lambda (mode31_0 path33_0 proc34_0)
(begin
(begin
(if (path-string? path33_0)
(void)
(raise-argument-error
'with-input-from-file
"path-string?"
path33_0))
(if (if (procedure? proc34_0)
(procedure-arity-includes? proc34_0 0)
#f)
(void)
(raise-argument-error 'with-input-from-file "(-> any)" proc34_0))
(if (memq mode31_0 '(binary text))
(void)
(raise-argument-error
'with-input-from-file
binary-or-text-desc
mode31_0))
(with-input-from-file path33_0 proc34_0 mode31_0))))))
(define call-with-input-file*.1
(|#%name|
call-with-input-file*
(lambda (mode43_0 path45_0 proc46_0)
(begin
(begin
(if (path-string? path45_0)
(void)
(raise-argument-error
'call-with-input-file*
"path-string?"
path45_0))
(if (if (procedure? proc46_0)
(procedure-arity-includes? proc46_0 1)
#f)
(void)
(raise-argument-error
'call-with-input-file*
"(input-port? . -> . any)"
proc46_0))
(if (memq mode43_0 '(binary text))
(void)
(raise-argument-error
'call-with-input-file*
binary-or-text-desc
mode43_0))
(let ((p_0 (open-input-file path45_0 mode43_0)))
(dynamic-wind
void
(lambda () (|#%app| proc46_0 p_0))
(lambda () (close-input-port p_0)))))))))
(define the-empty-hash hash2725)
(define the-empty-hasheq hash2610)
(define the-empty-hasheqv hash2589)
(define set
(case-lambda
(() the-empty-hash)
(l_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((s_1
(let ((s_1 (hash-set s_0 e_0 #t))) (values s_1))))
(for-loop_0 s_1 rest_0))))
s_0))))))
(for-loop_0 the-empty-hash l_0))))))
(define seteq
(case-lambda
(() the-empty-hasheq)
(l_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((s_1
(let ((s_1 (hash-set s_0 e_0 #t))) (values s_1))))
(for-loop_0 s_1 rest_0))))
s_0))))))
(for-loop_0 the-empty-hasheq l_0))))))
(define seteqv (lambda () the-empty-hasheqv))
(define set? (lambda (s_0) (hash? s_0)))
(define set-empty? (lambda (s_0) (zero? (hash-count s_0))))
(define set-member? (lambda (s_0 e_0) (hash-ref s_0 e_0 #f)))
(define set-count (lambda (s_0) (hash-count s_0)))
(define set-add (lambda (s_0 e_0) (hash-set s_0 e_0 #t)))
(define set-remove (lambda (s_0 e_0) (hash-remove s_0 e_0)))
(define set-first
(lambda (s_0) (hash-iterate-key s_0 (hash-iterate-first s_0))))
(define subset? (lambda (s1_0 s2_0) (hash-keys-subset? s1_0 s2_0)))
(define set=?
(lambda (s1_0 s2_0)
(let ((or-part_0 (eq? s1_0 s2_0)))
(if or-part_0
or-part_0
(if (let ((app_0 (hash-count s1_0))) (= app_0 (hash-count s2_0)))
(hash-keys-subset? s1_0 s2_0)
#f)))))
(define set-subtract
(lambda (s1_0 s2_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s1_1 i_0)
(begin
(if i_0
(let ((k_0 (unsafe-immutable-hash-iterate-key s2_0 i_0)))
(let ((s1_2
(let ((s1_2 (hash-remove s1_1 k_0))) (values s1_2))))
(for-loop_0
s1_2
(unsafe-immutable-hash-iterate-next s2_0 i_0))))
s1_1))))))
(for-loop_0 s1_0 (unsafe-immutable-hash-iterate-first s2_0))))))
(define set-union
(lambda (s1_0 s2_0)
(if (let ((app_0 (begin-unsafe (hash-count s1_0))))
(< app_0 (begin-unsafe (hash-count s2_0))))
(set-union s2_0 s1_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s1_1 i_0)
(begin
(if i_0
(let ((k_0 (unsafe-immutable-hash-iterate-key s2_0 i_0)))
(let ((s1_2
(let ((s1_2 (hash-set s1_1 k_0 #t)))
(values s1_2))))
(for-loop_0
s1_2
(unsafe-immutable-hash-iterate-next s2_0 i_0))))
s1_1))))))
(for-loop_0 s1_0 (unsafe-immutable-hash-iterate-first s2_0)))))))
(define set-intersect
(lambda (s1_0 s2_0)
(if (let ((app_0 (begin-unsafe (hash-count s1_0))))
(< app_0 (begin-unsafe (hash-count s2_0))))
(set-intersect s2_0 s1_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_0 i_0)
(begin
(if i_0
(let ((k_0 (unsafe-immutable-hash-iterate-key s2_0 i_0)))
(let ((s_1
(let ((s_1
(if (hash-ref s1_0 k_0 #f)
s_0
(hash-remove s_0 k_0))))
(values s_1))))
(for-loop_0
s_1
(unsafe-immutable-hash-iterate-next s2_0 i_0))))
s_0))))))
(for-loop_0 s2_0 (unsafe-immutable-hash-iterate-first s2_0)))))))
(define set-partition
(lambda (s_0 pred_0 empty-y-set_0 empty-n-set_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (y_0 n_0 i_0)
(begin
(if i_0
(let ((v_0 (unsafe-immutable-hash-iterate-key s_0 i_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(if (|#%app| pred_0 v_0)
(values (begin-unsafe (hash-set y_0 v_0 #t)) n_0)
(values y_0 (begin-unsafe (hash-set n_0 v_0 #t)))))
(case-lambda
((y_1 n_1) (values y_1 n_1))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((y_1 n_1)
(for-loop_0
y_1
n_1
(unsafe-immutable-hash-iterate-next s_0 i_0)))
(args (raise-binding-result-arity-error 2 args)))))
(values y_0 n_0)))))))
(for-loop_0
empty-y-set_0
empty-n-set_0
(unsafe-immutable-hash-iterate-first s_0))))))
(define set->list
(lambda (s_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 i_0)
(begin
(if i_0
(let ((k_0 (unsafe-immutable-hash-iterate-key s_0 i_0)))
(let ((fold-var_1 (cons k_0 fold-var_0)))
(let ((fold-var_2 (values fold-var_1)))
(for-loop_0
fold-var_2
(unsafe-immutable-hash-iterate-next s_0 i_0)))))
fold-var_0))))))
(for-loop_0 null (unsafe-immutable-hash-iterate-first s_0)))))))
(define list->set
(lambda (l_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0)
(begin
(if (pair? lst_0)
(let ((k_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values k_0 #t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 l_0)))))
(define list->seteq
(lambda (l_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0)
(begin
(if (pair? lst_0)
(let ((k_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values k_0 #t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2610 l_0)))))
(define start-atomic (lambda () (unsafe-start-atomic)))
(define end-atomic (lambda () (unsafe-end-atomic)))
(define start-breakable-atomic (lambda () (unsafe-start-breakable-atomic)))
(define end-breakable-atomic (lambda () (unsafe-end-breakable-atomic)))
(define cell.1$10 (unsafe-make-place-local #f))
(define entered-err-string-handler
(lambda (s_0 n_0)
(call-as-nonatomic
(lambda () (|#%app| (error-value->string-handler) s_0 n_0)))))
(define cell.2$5 (unsafe-make-place-local #f))
(define cell.3$2 (unsafe-make-place-local #f))
(define cell.4$2 (unsafe-make-place-local 0))
(define exited-key (gensym 'as-exit))
(define lock-tag (make-continuation-prompt-tag 'lock))
(define call-as-atomic
(lambda (f_0)
(begin
(if (if (procedure? f_0) (procedure-arity-includes? f_0 0) #f)
(void)
(raise-type-error 'call-as-atomic "procedure (arity 0)" f_0))
(if (eq? (unsafe-place-local-ref cell.1$10) (current-thread))
(dynamic-wind
(lambda ()
(begin
(begin-unsafe (unsafe-start-breakable-atomic))
(unsafe-place-local-set!
cell.4$2
(add1 (unsafe-place-local-ref cell.4$2)))))
f_0
(lambda ()
(begin
(unsafe-place-local-set!
cell.4$2
(sub1 (unsafe-place-local-ref cell.4$2)))
(begin-unsafe (unsafe-end-breakable-atomic)))))
(with-continuation-mark*
general
exited-key
#f
(call-with-continuation-prompt
(lambda ()
(dynamic-wind
(lambda ()
(begin
(begin-unsafe (unsafe-start-breakable-atomic))
(unsafe-place-local-set! cell.1$10 (current-thread))))
(lambda ()
(begin
(unsafe-place-local-set! cell.2$5 (current-parameterization))
(unsafe-place-local-set!
cell.3$2
(current-break-parameterization))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
error-value->string-handler
entered-err-string-handler)
(with-continuation-mark*
authentic
break-enabled-key
(make-thread-cell #f)
(begin
(check-for-break)
(call-with-exception-handler
(lambda (exn_0)
(if (continuation-mark-set-first #f exited-key)
exn_0
(abort-current-continuation
lock-tag
(lambda () (raise exn_0)))))
f_0))))))
(lambda ()
(begin
(unsafe-place-local-set! cell.1$10 #f)
(unsafe-place-local-set! cell.2$5 #f)
(unsafe-place-local-set! cell.3$2 #f)
(begin-unsafe (unsafe-end-breakable-atomic))))))
lock-tag
(lambda (t_0) (|#%app| t_0))))))))
(define call-as-nonatomic
(lambda (f_0)
(begin
(if (if (procedure? f_0) (procedure-arity-includes? f_0 0) #f)
(void)
(raise-type-error 'call-as-nonatomic "procedure (arity 0)" f_0))
(if (eq? (unsafe-place-local-ref cell.1$10) (current-thread))
(void)
(error 'call-as-nonatomic "not in atomic area for ~e" f_0))
(let ((paramz_0 (unsafe-place-local-ref cell.2$5)))
(let ((break-paramz_0 (unsafe-place-local-ref cell.3$2)))
(let ((extra-depth_0 (unsafe-place-local-ref cell.4$2)))
(with-continuation-mark*
general
exited-key
#t
(call-with-parameterization
paramz_0
(lambda ()
(call-with-break-parameterization
break-paramz_0
(lambda ()
(dynamic-wind
(lambda ()
(begin
(unsafe-place-local-set! cell.1$10 #f)
(unsafe-place-local-set! cell.4$2 0)
(begin-unsafe (unsafe-end-breakable-atomic))
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (zero? i_0)
(void)
(begin
(begin-unsafe
(unsafe-end-breakable-atomic))
(loop_0 (sub1 i_0)))))))))
(loop_0 extra-depth_0))))
f_0
(lambda ()
(begin
(begin-unsafe (unsafe-start-breakable-atomic))
(unsafe-place-local-set! cell.2$5 paramz_0)
(unsafe-place-local-set! cell.3$2 break-paramz_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (zero? i_0)
(void)
(begin
(begin-unsafe
(unsafe-start-breakable-atomic))
(loop_0 (sub1 i_0)))))))))
(loop_0 extra-depth_0))
(unsafe-place-local-set! cell.4$2 extra-depth_0)
(unsafe-place-local-set!
cell.1$10
(current-thread))))))))))))))))
(define not-an-fX.1
(|#%name|
not-an-fX
(lambda (who_0 v_0) (begin (raise-argument-error who_0 "fixnum?" v_0)))))
(define-values
(prop:serialize serialize? serialize-ref)
(make-struct-type-property 'serialize))
(define-values
(prop:serialize-fill! serialize-fill!? serialize-fill!-ref)
(make-struct-type-property 'serialize-fill!))
(define-values
(prop:reach-scopes reach-scopes? reach-scopes-ref)
(make-struct-type-property 'reach-scopes))
(define-values
(prop:scope-with-bindings scope-with-bindings? scope-with-bindings-ref)
(make-struct-type-property 'scope-with-bindings))
(define-values
(prop:binding-reach-scopes binding-reach-scopes? binding-reach-scopes-ref)
(make-struct-type-property 'binding-reach-scopes))
(define log-performance?
(if (environment-variables-ref
(current-environment-variables)
#vu8(80 76 84 95 69 88 80 65 78 68 69 82 95 84 73 77 69 83))
#t
#f))
(define cell.1$9 (unsafe-make-place-local #f))
(define cell.2$4 (unsafe-make-place-local (make-hasheq)))
(define performance-place-init!
(lambda () (unsafe-place-local-set! cell.2$4 (make-hasheq))))
(define struct:region
(make-record-type-descriptor*
'region
#f
(|#%nongenerative-uid| region)
#f
#f
5
30))
(define effect_2100
(struct-type-install-properties!
struct:region
'region
5
0
#f
null
(current-inspector)
#f
'(0)
#f
'region))
(define region1.1
(|#%name|
region
(record-constructor
(make-record-constructor-descriptor struct:region #f #f))))
(define region?_2430 (|#%name| region? (record-predicate struct:region)))
(define region?
(|#%name|
region?
(lambda (v)
(if (region?_2430 v)
#t
($value
(if (impersonator? v) (region?_2430 (impersonator-val v)) #f))))))
(define region-path_2994
(|#%name| region-path (record-accessor struct:region 0)))
(define region-path
(|#%name|
region-path
(lambda (s)
(if (region?_2430 s)
(region-path_2994 s)
($value
(impersonate-ref region-path_2994 struct:region 0 s 'region 'path))))))
(define region-start_2092
(|#%name| region-start (record-accessor struct:region 1)))
(define region-start
(|#%name|
region-start
(lambda (s)
(if (region?_2430 s)
(region-start_2092 s)
($value
(impersonate-ref
region-start_2092
struct:region
1
s
'region
'start))))))
(define region-start-memory_2878
(|#%name| region-start-memory (record-accessor struct:region 2)))
(define region-start-memory
(|#%name|
region-start-memory
(lambda (s)
(if (region?_2430 s)
(region-start-memory_2878 s)
($value
(impersonate-ref
region-start-memory_2878
struct:region
2
s
'region
'start-memory))))))
(define region-as-nested_2870
(|#%name| region-as-nested (record-accessor struct:region 3)))
(define region-as-nested
(|#%name|
region-as-nested
(lambda (s)
(if (region?_2430 s)
(region-as-nested_2870 s)
($value
(impersonate-ref
region-as-nested_2870
struct:region
3
s
'region
'as-nested))))))
(define region-as-nested-memory_2442
(|#%name| region-as-nested-memory (record-accessor struct:region 4)))
(define region-as-nested-memory
(|#%name|
region-as-nested-memory
(lambda (s)
(if (region?_2430 s)
(region-as-nested-memory_2442 s)
($value
(impersonate-ref
region-as-nested-memory_2442
struct:region
4
s
'region
'as-nested-memory))))))
(define set-region-start!_2321
(|#%name| set-region-start! (record-mutator struct:region 1)))
(define set-region-start!
(|#%name|
set-region-start!
(lambda (s v)
(if (region?_2430 s)
(set-region-start!_2321 s v)
($value
(impersonate-set!
set-region-start!_2321
struct:region
1
1
s
v
'region
'start))))))
(define set-region-start-memory!_3209
(|#%name| set-region-start-memory! (record-mutator struct:region 2)))
(define set-region-start-memory!
(|#%name|
set-region-start-memory!
(lambda (s v)
(if (region?_2430 s)
(set-region-start-memory!_3209 s v)
($value
(impersonate-set!
set-region-start-memory!_3209
struct:region
2
2
s
v
'region
'start-memory))))))
(define set-region-as-nested!_2510
(|#%name| set-region-as-nested! (record-mutator struct:region 3)))
(define set-region-as-nested!
(|#%name|
set-region-as-nested!
(lambda (s v)
(if (region?_2430 s)
(set-region-as-nested!_2510 s v)
($value
(impersonate-set!
set-region-as-nested!_2510
struct:region
3
3
s
v
'region
'as-nested))))))
(define set-region-as-nested-memory!_2903
(|#%name| set-region-as-nested-memory! (record-mutator struct:region 4)))
(define set-region-as-nested-memory!
(|#%name|
set-region-as-nested-memory!
(lambda (s v)
(if (region?_2430 s)
(set-region-as-nested-memory!_2903 s v)
($value
(impersonate-set!
set-region-as-nested-memory!_2903
struct:region
4
4
s
v
'region
'as-nested-memory))))))
(define struct:stat
(make-record-type-descriptor*
'stat
#f
(|#%nongenerative-uid| stat)
#f
#f
3
7))
(define effect_2634
(struct-type-install-properties!
struct:stat
'stat
3
0
#f
null
(current-inspector)
#f
'()
#f
'stat))
(define stat2.1
(|#%name|
stat
(record-constructor
(make-record-constructor-descriptor struct:stat #f #f))))
(define stat?_2843 (|#%name| stat? (record-predicate struct:stat)))
(define stat?
(|#%name|
stat?
(lambda (v)
(if (stat?_2843 v)
#t
($value (if (impersonator? v) (stat?_2843 (impersonator-val v)) #f))))))
(define stat-msecs_3052 (|#%name| stat-msecs (record-accessor struct:stat 0)))
(define stat-msecs
(|#%name|
stat-msecs
(lambda (s)
(if (stat?_2843 s)
(stat-msecs_3052 s)
($value
(impersonate-ref stat-msecs_3052 struct:stat 0 s 'stat 'msecs))))))
(define stat-memory_2120
(|#%name| stat-memory (record-accessor struct:stat 1)))
(define stat-memory
(|#%name|
stat-memory
(lambda (s)
(if (stat?_2843 s)
(stat-memory_2120 s)
($value
(impersonate-ref stat-memory_2120 struct:stat 1 s 'stat 'memory))))))
(define stat-count_2033 (|#%name| stat-count (record-accessor struct:stat 2)))
(define stat-count
(|#%name|
stat-count
(lambda (s)
(if (stat?_2843 s)
(stat-count_2033 s)
($value
(impersonate-ref stat-count_2033 struct:stat 2 s 'stat 'count))))))
(define set-stat-msecs!_2321
(|#%name| set-stat-msecs! (record-mutator struct:stat 0)))
(define set-stat-msecs!
(|#%name|
set-stat-msecs!
(lambda (s v)
(if (stat?_2843 s)
(set-stat-msecs!_2321 s v)
($value
(impersonate-set!
set-stat-msecs!_2321
struct:stat
0
0
s
v
'stat
'msecs))))))
(define set-stat-memory!_2358
(|#%name| set-stat-memory! (record-mutator struct:stat 1)))
(define set-stat-memory!
(|#%name|
set-stat-memory!
(lambda (s v)
(if (stat?_2843 s)
(set-stat-memory!_2358 s v)
($value
(impersonate-set!
set-stat-memory!_2358
struct:stat
1
1
s
v
'stat
'memory))))))
(define set-stat-count!_2436
(|#%name| set-stat-count! (record-mutator struct:stat 2)))
(define set-stat-count!
(|#%name|
set-stat-count!
(lambda (s v)
(if (stat?_2843 s)
(set-stat-count!_2436 s v)
($value
(impersonate-set!
set-stat-count!_2436
struct:stat
2
2
s
v
'stat
'count))))))
(define stat-key (gensym))
(define start-performance-region
(lambda path_0
(unsafe-place-local-set!
cell.1$9
(cons
(let ((app_0
(if (unsafe-place-local-ref cell.1$9)
(letrec*
((loop_0
(|#%name|
loop
(lambda (path_1 enclosing-path_0)
(begin
(if (null? path_1)
null
(let ((app_0
(if (if (eq? '_ (car path_1))
(pair? enclosing-path_0)
#f)
(car enclosing-path_0)
(car path_1))))
(cons
app_0
(let ((app_1 (cdr path_1)))
(loop_0
app_1
(if (pair? enclosing-path_0)
(cdr enclosing-path_0)
null)))))))))))
(loop_0
path_0
(region-path (car (unsafe-place-local-ref cell.1$9)))))
path_0)))
(let ((app_1 (current-inexact-milliseconds)))
(region1.1 app_0 app_1 (current-memory-use 'cumulative) 0.0 0)))
(unsafe-place-local-ref cell.1$9)))))
(define end-performance-region
(lambda ()
(let ((now_0 (current-inexact-milliseconds)))
(let ((now-memory_0 (current-memory-use 'cumulative)))
(let ((r_0 (car (unsafe-place-local-ref cell.1$9))))
(begin
(unsafe-place-local-set!
cell.1$9
(cdr (unsafe-place-local-ref cell.1$9)))
(let ((full-delta_0 (- now_0 (region-start r_0))))
(let ((delta_0 (- full-delta_0 (region-as-nested r_0))))
(let ((full-delta-memory_0
(- now-memory_0 (region-start-memory r_0))))
(let ((delta-memory_0
(-
full-delta-memory_0
(region-as-nested-memory r_0))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (accums_0 path_0)
(begin
(let ((key_0 (car path_0)))
(let ((accum_0
(let ((or-part_0
(hash-ref accums_0 key_0 #f)))
(if or-part_0
or-part_0
(let ((accum_0 (make-hasheq)))
(begin
(hash-set!
accums_0
key_0
accum_0)
accum_0))))))
(let ((s_0
(let ((or-part_0
(hash-ref
accum_0
stat-key
#f)))
(if or-part_0
or-part_0
(let ((s_0 (stat2.1 0.0 0 0)))
(begin
(hash-set!
accum_0
stat-key
s_0)
s_0))))))
(begin
(set-stat-msecs!
s_0
(+ delta_0 (stat-msecs s_0)))
(set-stat-memory!
s_0
(+ delta-memory_0 (stat-memory s_0)))
(if (null? (cdr path_0))
(set-stat-count!
s_0
(add1 (stat-count s_0)))
(void))
(if (null? (cdr path_0))
(void)
(loop_0 accum_0 (cdr path_0))))))))))))
(loop_0
(unsafe-place-local-ref cell.2$4)
(region-path r_0)))
(if (unsafe-place-local-ref cell.1$9)
(begin
(let ((app_0
(car (unsafe-place-local-ref cell.1$9))))
(set-region-as-nested!
app_0
(+
(region-as-nested
(car (unsafe-place-local-ref cell.1$9)))
full-delta_0)))
(let ((app_0
(car (unsafe-place-local-ref cell.1$9))))
(set-region-as-nested-memory!
app_0
(+
(region-as-nested-memory
(car (unsafe-place-local-ref cell.1$9)))
full-delta-memory_0))))
(void)))))))))))))
(define effect_2814
(begin
(|#%call-with-values|
(lambda ()
(if log-performance?
(void
(plumber-add-flush!
(current-plumber)
(lambda (h_0)
(let ((whole-len_0
(|#%name|
whole-len
(lambda (s_0)
(begin
(caar
(let ((or-part_0
(regexp-match-positions rx2668 s_0)))
(if or-part_0 or-part_0 '(0)))))))))
(let ((kb_0
(|#%name|
kb
(lambda (b_0)
(begin
(let ((s_0 (number->string (quotient b_0 1024))))
(list->string
(let ((lst_0 (reverse$1 (string->list s_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (l_0 lst_1 pos_0)
(begin
(if (if (pair? lst_1) #t #f)
(let ((c_0 (unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((l_1
(let ((l_1
(if (if (positive?
pos_0)
(zero?
(modulo
pos_0
3))
#f)
(list*
c_0
'#\x2c
l_0)
(cons
c_0
l_0))))
(values l_1))))
(for-loop_0
l_1
rest_0
(+ pos_0 1)))))
l_0))))))
(for-loop_0 null lst_0 0)))))))))))
(call-with-values
(lambda ()
(letrec*
((loop_0
(|#%name|
loop
(lambda (accums_0
label-len_0
value-len_0
memory-len_0
count-len_0
indent_0)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (label-len_1
value-len_1
memory-len_1
count-len_1
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
accums_0
i_0))
(case-lambda
((k_0 v_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(if (eq? k_0 stat-key)
(let ((app_0
(max
value-len_1
(whole-len_0
(format
"~a"
(stat-msecs
v_0))))))
(let ((app_1
(max
memory-len_1
(string-length
(format
"~a"
(kb_0
(stat-memory
v_0)))))))
(values
label-len_1
app_0
app_1
(max
count-len_1
(string-length
(format
"~a"
(stat-count
v_0)))))))
(let ((app_0
(max
label-len_1
(+
indent_0
(string-length
(format
"~a"
k_0))))))
(loop_0
v_0
app_0
value-len_1
memory-len_1
count-len_1
(+ 2 indent_0)))))
(case-lambda
((label-len_2
value-len_2
memory-len_2
count-len_2)
(values
label-len_2
value-len_2
memory-len_2
count-len_2))
(args
(raise-binding-result-arity-error
4
args)))))
(case-lambda
((label-len_2
value-len_2
memory-len_2
count-len_2)
(for-loop_0
label-len_2
value-len_2
memory-len_2
count-len_2
(hash-iterate-next
accums_0
i_0)))
(args
(raise-binding-result-arity-error
4
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(values
label-len_1
value-len_1
memory-len_1
count-len_1)))))))
(for-loop_0
label-len_0
value-len_0
memory-len_0
count-len_0
(hash-iterate-first accums_0)))))))))
(loop_0 (unsafe-place-local-ref cell.2$4) 6 5 4 5 2)))
(case-lambda
((label-max-len_0
value-max-len_0
memory-max-len_0
count-max-len_0)
(begin
(let ((l_0 (current-logger)))
(if (log-level? l_0 'error (logger-name l_0))
(let ((app_0
(let ((app_0
(make-string
(-
(+ label-max-len_0 value-max-len_0)
11)
'#\x20)))
(let ((app_1
(make-string
(- memory-max-len_0 4)
'#\x20)))
(format
"REGION ~aMSECS ~aMEMK ~aCOUNT"
app_0
app_1
(make-string
(- count-max-len_0 5)
'#\x20))))))
(log-message
l_0
'error
app_0
(current-continuation-marks)))
(void)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (name_0 accums_0 indent_0 newline?_0)
(begin
(begin
(if name_0
(let ((v_0 (hash-ref accums_0 stat-key)))
(let ((l_0 (current-logger)))
(if (log-level?
l_0
'error
(logger-name l_0))
(let ((app_0
(let ((app_0
(make-string
(let ((app_0
(let ((app_0
(string-length
(format
"~a"
name_0))))
(-
label-max-len_0
app_0
(string-length
indent_0)))))
(+
app_0
(-
value-max-len_0
(whole-len_0
(format
"~a"
(stat-msecs
v_0))))))
'#\x20)))
(let ((app_1
(regexp-replace
rx2640
(format
"~a00"
(stat-msecs v_0))
".\\1")))
(let ((app_2
(make-string
(-
memory-max-len_0
(string-length
(format
"~a"
(kb_0
(stat-memory
v_0)))))
'#\x20)))
(let ((app_3
(kb_0
(stat-memory
v_0))))
(let ((app_4
(make-string
(-
count-max-len_0
(string-length
(format
"~a"
(stat-count
v_0))))
'#\x20)))
(format
"~a~a ~a~a ~a~a ~a~a"
indent_0
name_0
app_0
app_1
app_2
app_3
app_4
(stat-count
v_0)))))))))
(log-message
l_0
'error
app_0
(current-continuation-marks)))
(void))))
(void))
(let ((keys_0
(let ((temp5_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 i_0)
(begin
(if i_0
(let ((k_0
(hash-iterate-key
accums_0
i_0)))
(let ((fold-var_1
(if (not
(eq?
k_0
stat-key))
(let ((fold-var_1
(cons
k_0
fold-var_0)))
(values
fold-var_1))
fold-var_0)))
(for-loop_0
fold-var_1
(hash-iterate-next
accums_0
i_0))))
fold-var_0))))))
(for-loop_0
null
(hash-iterate-first
accums_0)))))))
(let ((temp7_0
(lambda (key_0)
(stat-msecs
(hash-ref
(hash-ref accums_0 key_0)
stat-key)))))
(let ((temp5_1 temp5_0))
(sort.1 #f temp7_0 temp5_1 >))))))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((k_0 (unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(begin
(begin
(if (if newline?_0
(positive? pos_0)
#f)
(let ((l_0
(current-logger)))
(if (log-level?
l_0
'error
(logger-name
l_0))
(log-message
l_0
'error
""
(current-continuation-marks))
(void)))
(void))
(let ((app_0
(hash-ref
accums_0
k_0)))
(loop_0
k_0
app_0
(string-append
indent_0
" ")
#f)))
(for-loop_0
rest_0
(+ pos_0 1)))))
(values)))))))
(for-loop_0 keys_0 0)))
(void)))))))))
(loop_0 #f (unsafe-place-local-ref cell.2$4) "" #t))))
(args (raise-binding-result-arity-error 4 args)))))))))
(void)))
print-values)
(void)))
(define 1/module-path?
(|#%name|
module-path?
(lambda (v_0)
(begin
(let ((or-part_0
(if (pair? v_0)
(if (eq? (car v_0) 'submod) (submodule-module-path? v_0) #f)
#f)))
(if or-part_0 or-part_0 (root-module-path? v_0)))))))
(define root-module-path?
(lambda (v_0)
(let ((or-part_0 (path? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (if (string? v_0) (string-module-path? v_0) #f)))
(if or-part_1
or-part_1
(let ((or-part_2 (if (symbol? v_0) (symbol-module-path? v_0) #f)))
(if or-part_2
or-part_2
(if (pair? v_0)
(let ((tmp_0 (car v_0)))
(if (eq? tmp_0 'quote)
(if (pair? (cdr v_0))
(if (symbol? (cadr v_0)) (null? (cddr v_0)) #f)
#f)
(if (eq? tmp_0 'lib)
(lib-module-path? v_0)
(if (eq? tmp_0 'file)
(if (pair? (cdr v_0))
(if (string? (cadr v_0))
(if (path-string? (cadr v_0))
(null? (cddr v_0))
#f)
#f)
#f)
(if (eq? tmp_0 'planet)
(planet-module-path? v_0)
#f)))))
#f)))))))))
(define submodule-module-path?
(lambda (v_0)
(if (pair? (cdr v_0))
(if (list? v_0)
(if (let ((or-part_0 (equal? (cadr v_0) "..")))
(if or-part_0
or-part_0
(let ((or-part_1 (equal? (cadr v_0) ".")))
(if or-part_1 or-part_1 (root-module-path? (cadr v_0))))))
(let ((lst_0 (cddr v_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((e_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1
(let ((result_1
(let ((or-part_0 (equal? e_0 "..")))
(if or-part_0
or-part_0
(symbol? e_0)))))
(values result_1))))
(if (if (not
(let ((x_0 (list e_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t lst_0))))
#f)
#f)
#f)))
(define string-module-path?
(lambda (v_0) (module-path-string?.1 #t #t #f #t v_0)))
(define symbol-module-path?
(lambda (v_0)
(let ((temp15_0 (symbol->string v_0)))
(module-path-string?.1 #f #f #f #f temp15_0))))
(define lib-module-path?
(lambda (v_0)
(if (list? v_0)
(if (pair? (cdr v_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_1 first?_0)
(begin
(let ((or-part_0 (null? v_1)))
(if or-part_0
or-part_0
(if (string? (car v_1))
(if (let ((temp16_0 (car v_1)))
(module-path-string?.1
#f
first?_0
#f
first?_0
temp16_0))
(loop_0 (cdr v_1) #f)
#f)
#f))))))))
(loop_0 (cdr v_0) #t))
#f)
#f)))
(define planet-module-path?
(lambda (v_0)
(if (list? v_0)
(let ((tmp_0 (length v_0)))
(if (eq? tmp_0 1)
#f
(if (eq? tmp_0 2)
(let ((e_0 (cadr v_0)))
(if (string? e_0)
(module-path-string?.1 #f #t #t #f e_0)
(if (symbol? e_0)
(let ((temp22_0 (symbol->string e_0)))
(module-path-string?.1 #f #f #t #f temp22_0))
#f)))
(let ((file_0 (cadr v_0)))
(let ((pkg_0 (caddr v_0)))
(let ((subs_0 (cdddr v_0)))
(if file_0
(if (module-path-string?.1 #f #t #f #t file_0)
(if (if (list? pkg_0)
(if (<= 2 (length pkg_0) 4)
(if (planet-user/pkg-string? (car pkg_0))
(if (planet-user/pkg-string? (cadr pkg_0))
(let ((or-part_0 (null? (cddr pkg_0))))
(if or-part_0
or-part_0
(let ((or-part_1
(let ((v_1 (caddr pkg_0)))
(begin-unsafe
(exact-nonnegative-integer?
v_1)))))
(if or-part_1
or-part_1
(let ((or-part_2
(null? (cddr pkg_0))))
(if or-part_2
or-part_2
(planet-version-minor-spec?
(cadddr pkg_0))))))))
#f)
#f)
#f)
#f)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((sub_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1
(module-path-string?.1
#f
#f
#f
#f
sub_0)))
(values result_1))))
(if (if (not
(let ((x_0 (list sub_0)))
(not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t subs_0)))
#f)
#f)
#f)))))))
#f)))
(define planet-version-number? (lambda (v_0) (exact-nonnegative-integer? v_0)))
(define planet-version-minor-spec?
(lambda (v_0)
(let ((or-part_0 (begin-unsafe (exact-nonnegative-integer? v_0))))
(if or-part_0
or-part_0
(if (pair? v_0)
(if (list? v_0)
(if (= 2 (length v_0))
(let ((tmp_0 (car v_0)))
(if (if (eq? tmp_0 '=)
#t
(if (eq? tmp_0 '+) #t (eq? tmp_0 '-)))
(let ((v_1 (cadr v_0)))
(begin-unsafe (exact-nonnegative-integer? v_1)))
(if (let ((v_1 (car v_0)))
(begin-unsafe (exact-nonnegative-integer? v_1)))
(let ((v_1 (cadr v_0)))
(begin-unsafe (exact-nonnegative-integer? v_1)))
#f)))
#f)
#f)
#f)))))
(define module-path-string?.1
(|#%name|
module-path-string?
(lambda (dots-dir-ok?2_0
file-end-ok?4_0
for-planet?1_0
just-file-ok?3_0
v9_0)
(begin
(let ((len_0 (string-length v9_0)))
(if (positive? len_0)
(if (not (char=? '#\x2f (string-ref v9_0 0)))
(if (not (char=? '#\x2f (string-ref v9_0 (sub1 len_0))))
(call-with-values
(lambda ()
(if for-planet?1_0
(check-planet-part v9_0 len_0)
(values 0 0)))
(case-lambda
((start-package-version-pos_0 end-package-version-pos_0)
(if start-package-version-pos_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 prev-was-slash?_0 saw-slash?_0 saw-dot?_0)
(begin
(if (not (negative? i_0))
(let ((c_0 (string-ref v9_0 i_0)))
(if (char=? c_0 '#\x2f)
(if (not prev-was-slash?_0)
(loop_0 (sub1 i_0) #t #t saw-dot?_0)
#f)
(if (char=? c_0 '#\x2e)
(if (if (< (add1 i_0) len_0)
(if (not
(char=?
(string-ref v9_0 (add1 i_0))
'#\x2f))
(not
(char=?
(string-ref v9_0 (add1 i_0))
'#\x2e))
#f)
#f)
(if (not saw-slash?_0)
(loop_0 (sub1 i_0) #f saw-slash?_0 #t)
#f)
(loop_0
(sub1 i_0)
#f
saw-slash?_0
saw-dot?_0))
(if (let ((or-part_0 (plain-char? c_0)))
(if or-part_0
or-part_0
(if (char=? c_0 '#\x25)
(if (< (+ i_0 2) len_0)
(hex-sequence? v9_0 (add1 i_0))
#f)
#f)))
(loop_0
(sub1 i_0)
#f
saw-slash?_0
saw-dot?_0)
(if (if (>=
i_0
start-package-version-pos_0)
(< i_0 end-package-version-pos_0)
#f)
(loop_0
(sub1 i_0)
#f
saw-slash?_0
saw-dot?_0)
#f)))))
(if (not
(if (not just-file-ok?3_0)
(if saw-dot?_0 (not saw-slash?_0) #f)
#f))
(if dots-dir-ok?2_0
dots-dir-ok?2_0
(letrec*
((loop_1
(|#%name|
loop
(lambda (i_1)
(begin
(if (= i_1 len_0)
#t
(if (char=?
(string-ref v9_0 i_1)
'#\x2e)
(if (not
(let ((or-part_0
(=
len_0
(add1 i_1))))
(if or-part_0
or-part_0
(char=?
(string-ref
v9_0
(add1 i_1))
'#\x2f))))
(if (not
(if (char=?
(string-ref
v9_0
(add1 i_1))
'#\x2e)
(let ((or-part_0
(=
len_0
(+ i_1 2))))
(if or-part_0
or-part_0
(char=?
(string-ref
v9_0
(+ i_1 2))
'#\x2f)))
#f))
(loop_1
(letrec*
((loop_2
(|#%name|
loop
(lambda (i_2)
(begin
(if (char=?
'#\x2e
(string-ref
v9_0
i_2))
(loop_2
(add1 i_2))
i_2))))))
(loop_2 i_1)))
#f)
#f)
(loop_1 (add1 i_1)))))))))
(loop_1 0)))
#f)))))))
(loop_0 (sub1 len_0) #f (not file-end-ok?4_0) #f))
#f))
(args (raise-binding-result-arity-error 2 args))))
#f)
#f)
#f))))))
(define planet-user/pkg-string?
(lambda (v_0)
(if (string? v_0)
(let ((len_0 (string-length v_0)))
(if (positive? len_0)
(call-with-values
(lambda ()
(begin
(check-string v_0)
(values v_0 (unsafe-string-length v_0))))
(case-lambda
((vec_0 len_1)
(let ((start_0 0))
(let ((vec_1 vec_0) (len_2 len_1))
(begin
#f
(void)
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0 pos_1)
(begin
(if (if (unsafe-fx< pos_0 len_2) #t #f)
(let ((c_0 (string-ref vec_1 pos_0)))
(let ((result_1
(let ((result_1
(let ((or-part_0
(plain-char? c_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(char=? '#\x2e c_0)))
(if or-part_1
or-part_1
(if (char=? '#\x25 c_0)
(if (<
pos_1
(- len_0 2))
(hex-sequence?
v_0
(add1 pos_1))
#f)
#f)))))))
(values result_1))))
(if (if (not
(let ((x_0 (list c_0)))
(not result_1)))
(if (not
(let ((x_0 (list pos_1)))
(not result_1)))
#t
#f)
#f)
(for-loop_0
result_1
(unsafe-fx+ 1 pos_0)
(+ pos_1 1))
result_1)))
result_0))))))
(for-loop_0 #t 0 start_0))))))
(args (raise-binding-result-arity-error 2 args))))
#f))
#f)))
(define plain-char?
(lambda (c_0)
(let ((or-part_0 (char<=? '#\x61 c_0 '#\x7a)))
(if or-part_0
or-part_0
(let ((or-part_1 (char<=? '#\x41 c_0 '#\x5a)))
(if or-part_1
or-part_1
(let ((or-part_2 (char<=? '#\x30 c_0 '#\x39)))
(if or-part_2
or-part_2
(let ((or-part_3 (char=? '#\x2d c_0)))
(if or-part_3
or-part_3
(let ((or-part_4 (char=? '#\x5f c_0)))
(if or-part_4 or-part_4 (char=? '#\x2b c_0)))))))))))))
(define hex-sequence?
(lambda (s_0 i_0)
(let ((c1_0 (string-ref s_0 i_0)))
(let ((c2_0 (string-ref s_0 (add1 i_0))))
(if (hex-char? c1_0)
(if (hex-char? c2_0)
(let ((c_0
(integer->char
(let ((app_0 (* (hex-char->integer c1_0) 16)))
(+ app_0 (hex-char->integer c2_0))))))
(not (plain-char? c_0)))
#f)
#f)))))
(define hex-char?
(lambda (c_0)
(let ((or-part_0 (char<=? '#\x61 c_0 '#\x66)))
(if or-part_0 or-part_0 (char<=? '#\x30 c_0 '#\x39)))))
(define hex-char->integer
(lambda (c_0)
(if (char<=? '#\x61 c_0 '#\x66)
(- (char->integer c_0) 107)
(if (char<=? '#\x41 c_0 '#\x46)
(- (char->integer c_0) 75)
(- (char->integer c_0) 48)))))
(define check-planet-part
(lambda (v_0 len_0)
(call-with-values
(lambda ()
(letrec*
((loop_0
(|#%name|
loop
(lambda (j_0
start-package-version-pos_0
end-package-version-pos_0
colon1-pos_0
colon2-pos_0)
(begin
(if (= j_0 len_0)
(values
start-package-version-pos_0
(if end-package-version-pos_0 end-package-version-pos_0 j_0)
colon1-pos_0
colon2-pos_0)
(let ((tmp_0 (string-ref v_0 j_0)))
(if (eqv? tmp_0 '#\x2f)
(let ((app_0 (add1 j_0)))
(let ((app_1
(if start-package-version-pos_0
start-package-version-pos_0
(add1 j_0))))
(loop_0
app_0
app_1
(if start-package-version-pos_0
(if end-package-version-pos_0
end-package-version-pos_0
j_0)
#f)
colon1-pos_0
colon2-pos_0)))
(if (eqv? tmp_0 '#\x3a)
(if colon2-pos_0
(values #f #f #f #f)
(if colon1-pos_0
(loop_0
(add1 j_0)
start-package-version-pos_0
end-package-version-pos_0
colon1-pos_0
j_0)
(loop_0
(add1 j_0)
start-package-version-pos_0
end-package-version-pos_0
j_0
#f)))
(loop_0
(add1 j_0)
start-package-version-pos_0
end-package-version-pos_0
colon1-pos_0
colon2-pos_0))))))))))
(loop_0 0 #f #f #f #f)))
(case-lambda
((start-package-version-pos_0
end-package-version-pos_0
colon1-pos_0
colon2-pos_0)
(if (if start-package-version-pos_0
(if (> end-package-version-pos_0 start-package-version-pos_0)
(let ((or-part_0 (not colon2-pos_0)))
(if or-part_0
or-part_0
(< (add1 colon2-pos_0) end-package-version-pos_0)))
#f)
#f)
(if colon1-pos_0
(let ((colon1-end_0
(if colon2-pos_0 colon2-pos_0 end-package-version-pos_0)))
(if (if (integer-sequence? v_0 (add1 colon1-pos_0) colon1-end_0)
(let ((or-part_0 (not colon2-pos_0)))
(if or-part_0
or-part_0
(let ((tmp_0 (string-ref v_0 (add1 colon2-pos_0))))
(if (eqv? tmp_0 '#\x3d)
(integer-sequence?
v_0
(+ 2 colon2-pos_0)
end-package-version-pos_0)
(if (if (eqv? tmp_0 '#\x3e) #t (eqv? tmp_0 '#\x3c))
(if (if (<
(+ 2 colon2-pos_0)
end-package-version-pos_0)
(char=?
'#\x3d
(string-ref v_0 (+ colon2-pos_0 2)))
#f)
(integer-sequence?
v_0
(+ 3 colon2-pos_0)
end-package-version-pos_0)
(integer-sequence?
v_0
(+ 2 colon2-pos_0)
end-package-version-pos_0))
(integer-range-sequence?
v_0
(add1 colon2-pos_0)
end-package-version-pos_0))))))
#f)
(values colon1-pos_0 end-package-version-pos_0)
(values #f #f)))
(values 0 0))
(values #f #f)))
(args (raise-binding-result-arity-error 4 args))))))
(define integer-sequence?
(lambda (s_0 start_0 end_0)
(if (< start_0 end_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((result_1
(let ((result_1
(char<=?
'#\x30
(string-ref s_0 pos_0)
'#\x39)))
(values result_1))))
(if (if (not (let ((x_0 (list pos_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 (+ pos_0 1))
result_1))
result_0))))))
(for-loop_0 #t start_0)))
#f)))
(define integer-range-sequence?
(lambda (s_0 start_0 end_0)
(if (< start_0 end_0)
(if (begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((result_1
(let ((result_1
(let ((c_0 (string-ref s_0 pos_0)))
(let ((or-part_0 (char=? c_0 '#\x2d)))
(if or-part_0
or-part_0
(char<=? '#\x30 c_0 '#\x39))))))
(values result_1))))
(if (if (not (let ((x_0 (list pos_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 (+ pos_0 1))
result_1))
result_0))))))
(for-loop_0 #t start_0)))
(>=
1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((result_1
(let ((result_1
(+
result_0
(if (char=? (string-ref s_0 pos_0) '#\x2d)
1
0))))
(values result_1))))
(for-loop_0 result_1 (+ pos_0 1)))
result_0))))))
(for-loop_0 0 start_0))))
#f)
#f)))
(define struct:weak-intern-table
(make-record-type-descriptor*
'weak-intern-table
#f
(|#%nongenerative-uid| weak-intern-table)
#f
#f
1
0))
(define effect_2495
(struct-type-install-properties!
struct:weak-intern-table
'weak-intern-table
1
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'weak-intern-table))
(define weak-intern-table1.1
(|#%name|
weak-intern-table
(record-constructor
(make-record-constructor-descriptor struct:weak-intern-table #f #f))))
(define weak-intern-table?
(|#%name| weak-intern-table? (record-predicate struct:weak-intern-table)))
(define weak-intern-table-box
(|#%name|
weak-intern-table-box
(record-accessor struct:weak-intern-table 0)))
(define struct:table
(make-record-type-descriptor*
'table
#f
(|#%nongenerative-uid| table)
#f
#f
3
0))
(define effect_2793
(struct-type-install-properties!
struct:table
'table
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'table))
(define table2.1
(|#%name|
table
(record-constructor
(make-record-constructor-descriptor struct:table #f #f))))
(define table? (|#%name| table? (record-predicate struct:table)))
(define table-ht (|#%name| table-ht (record-accessor struct:table 0)))
(define table-count (|#%name| table-count (record-accessor struct:table 1)))
(define table-prune-at
(|#%name| table-prune-at (record-accessor struct:table 2)))
(define make-weak-intern-table
(lambda () (weak-intern-table1.1 (box (table2.1 (hasheqv) 0 128)))))
(define weak-intern!
(lambda (tt_0 v_0)
(let ((b_0 (weak-intern-table-box tt_0)))
(let ((t_0 (unbox b_0)))
(let ((code_0 (equal-hash-code v_0)))
(let ((vals_0 (hash-ref (table-ht t_0) code_0 null)))
(let ((or-part_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((b_1 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1
(let ((bv_0
(weak-box-value b_1)))
(if (equal? bv_0 v_0)
bv_0
#f))))
(values result_1))))
(if (if (not
(let ((x_0 (list b_1)))
result_1))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #f vals_0)))))
(if or-part_0
or-part_0
(let ((pruned-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)))
(let ((new-t_0
(let ((app_0
(hash-set
ht_0
code_0
(let ((app_0 (make-weak-box v_0)))
(cons
app_0
(hash-ref ht_0 code_0 null))))))
(table2.1
app_0
(add1 (table-count pruned-t_0))
(table-prune-at pruned-t_0)))))
(let ((or-part_1
(if (unsafe-box*-cas! b_0 t_0 new-t_0) v_0 #f)))
(if or-part_1
or-part_1
(weak-intern! tt_0 v_0))))))))))))))
(define prune-table
(lambda (t_0)
(let ((ht_0 (table-ht t_0)))
(let ((new-ht_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 vals_0)
(let ((table_1
(let ((new-vals_0
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((b_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(if (weak-box-value
b_0)
(let ((fold-var_1
(cons
b_0
fold-var_0)))
(values
fold-var_1))
fold-var_0)))
(for-loop_1
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_1 null vals_0))))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(if (pair? new-vals_0)
(let ((table_2
(call-with-values
(lambda ()
(values
k_0
new-vals_0))
(case-lambda
((key_0 val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_2))
table_1)))
table_2))))))
(for-loop_1 table_0))))))
(for-loop_0
table_1
(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))))))))
(define struct:resolved-module-path
(make-record-type-descriptor*
'resolved-module-path
#f
(|#%nongenerative-uid| resolved-module-path)
#f
#f
1
0))
(define effect_1951
(struct-type-install-properties!
struct:resolved-module-path
'resolved-module-path
1
0
#f
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (r_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2299)
(|#%app| ser-push!_0 (1/resolved-module-path-name r_0)))))
(cons
prop:custom-write
(lambda (r_0 port_0 mode_0)
(begin
(if mode_0 (write-string "#<resolved-module-path:" port_0) (void))
(fprintf
port_0
"~a"
(format-resolved-module-path-name (1/resolved-module-path-name r_0)))
(if mode_0 (write-string ">" port_0) (void)))))
(cons
prop:equal+hash
(list
(lambda (a_0 b_0 eql?_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)
(|#%app| hash-code_0 (1/resolved-module-path-name a_0))))))
(current-inspector)
#f
'(0)
#f
'resolved-module-path))
(define resolved-module-path1.1
(|#%name|
resolved-module-path
(record-constructor
(make-record-constructor-descriptor struct:resolved-module-path #f #f))))
(define 1/resolved-module-path?
(|#%name|
resolved-module-path?
(record-predicate struct:resolved-module-path)))
(define 1/resolved-module-path-name
(|#%name|
resolved-module-path-name
(record-accessor struct:resolved-module-path 0)))
(define format-resolved-module-path-name
(lambda (p_0)
(if (path? p_0)
(string-append "\"" (path->string p_0) "\"")
(if (symbol? p_0)
(format-symbol p_0)
(let ((app_0 (format-resolved-module-path-name (car p_0))))
(format-submod app_0 (cdr p_0)))))))
(define format-symbol
(lambda (p_0)
(format
"'~s~a"
p_0
(if (symbol-interned? p_0) "" (format "[~a]" (eq-hash-code p_0))))))
(define format-submod
(lambda (base_0 syms_0)
(format
"(submod ~a~a)"
base_0
(apply
string-append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((i_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons (format " ~s" i_0) fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null syms_0))))))))
(define resolved-module-path-root-name
(lambda (r_0)
(let ((name_0 (1/resolved-module-path-name r_0)))
(if (pair? name_0) (car name_0) name_0))))
(define resolved-module-paths (make-weak-intern-table))
(define 1/make-resolved-module-path
(|#%name|
make-resolved-module-path
(lambda (p_0)
(begin
(begin
(if (let ((or-part_0 (symbol? p_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (if (path? p_0) (complete-path? p_0) #f)))
(if or-part_1
or-part_1
(if (pair? p_0)
(if (pair? (cdr p_0))
(if (list? p_0)
(if (let ((or-part_2 (symbol? (car p_0))))
(if or-part_2
or-part_2
(if (path? (car p_0))
(complete-path? (car p_0))
#f)))
(let ((lst_0 (cdr p_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((s_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1 (symbol? s_0)))
(let ((result_2
(values result_1)))
(if (if (not
(let ((x_0
(list s_0)))
(not result_2)))
#t
#f)
(for-loop_0
result_2
rest_0)
result_2)))))
result_0))))))
(for-loop_0 #t lst_0))))
#f)
#f)
#f)
#f)))))
(void)
(raise-argument-error
'make-resolved-module-path
(string-append
"(or/c symbol?\n"
" (and/c path? complete-path?)\n"
" (cons/c (or/c symbol?\n"
" (and/c path? complete-path?))\n"
" (non-empty-listof symbol?)))")
p_0))
(weak-intern!
resolved-module-paths
(resolved-module-path1.1 p_0)))))))
(define resolved-module-path->module-path
(lambda (r_0)
(let ((name_0 (1/resolved-module-path-name r_0)))
(let ((root-name_0 (if (pair? name_0) (car name_0) name_0)))
(let ((root-mod-path_0
(if (path? root-name_0) root-name_0 (list 'quote root-name_0))))
(if (pair? name_0)
(list* 'submod root-mod-path_0 (cdr name_0))
root-mod-path_0))))))
(define struct:module-path-index
(make-record-type-descriptor*
'module-path-index
#f
(|#%nongenerative-uid| module-path-index)
#f
#f
4
12))
(define effect_2287
(struct-type-install-properties!
struct:module-path-index
'module-path-index
4
0
#f
(list
(cons prop:authentic #t)
(cons
prop:custom-write
(lambda (r_0 port_0 mode_0)
(begin
(write-string "#<module-path-index" port_0)
(if (|#%app| top-level-module-path-index? r_0)
(fprintf port_0 ":top-level")
(if (module-path-index-path r_0)
(let ((l_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (r_1)
(begin
(if (not r_1)
null
(if (1/resolved-module-path? r_1)
(list "+" (format "~a" r_1))
(if (module-path-index-path r_1)
(let ((app_0
(letrec*
((loop_1
(|#%name|
loop
(lambda (v_0)
(begin
(if (if (pair? v_0)
(if (eq?
'quote
(car v_0))
(null? (cddr v_0))
#f)
#f)
(format-symbol (cadr v_0))
(if (if (pair? v_0)
(eq?
'submod
(car v_0))
#f)
(let ((app_0
(loop_1
(cadr v_0))))
(format-submod
app_0
(cddr v_0)))
(format "~.s" v_0))))))))
(loop_1
(module-path-index-path r_1)))))
(cons
app_0
(loop_0 (module-path-index-base r_1))))
(if (module-path-index-resolved r_1)
(list
"+"
(format
"~a"
(module-path-index-resolved r_1)))
null)))))))))
(loop_0 r_0))))
(fprintf
port_0
":~.a"
(let ((app_0 (car l_0)))
(apply
string-append
app_0
(reverse$1
(let ((lst_0 (cdr l_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((i_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(format " ~a" i_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))))
(if (module-path-index-resolved r_0)
(fprintf port_0 "=~a" (module-path-index-resolved r_0))
(void))))
(write-string ">" port_0))))
(cons
prop:equal+hash
(list
(lambda (a_0 b_0 eql?_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))))
(+ app_0 (|#%app| hash-code_0 (module-path-index-base a_0)))))
(lambda (a_0 hash-code_0)
(let ((app_0 (|#%app| hash-code_0 (module-path-index-path a_0))))
(+ app_0 (|#%app| hash-code_0 (module-path-index-base a_0))))))))
(current-inspector)
#f
'(0 1)
#f
'module-path-index))
(define module-path-index2.1
(|#%name|
module-path-index
(record-constructor
(make-record-constructor-descriptor struct:module-path-index #f #f))))
(define 1/module-path-index?
(|#%name| module-path-index? (record-predicate struct:module-path-index)))
(define module-path-index-path
(|#%name|
module-path-index-path
(record-accessor struct:module-path-index 0)))
(define module-path-index-base
(|#%name|
module-path-index-base
(record-accessor struct:module-path-index 1)))
(define module-path-index-resolved
(|#%name|
module-path-index-resolved
(record-accessor struct:module-path-index 2)))
(define module-path-index-shift-cache
(|#%name|
module-path-index-shift-cache
(record-accessor struct:module-path-index 3)))
(define set-module-path-index-resolved!
(|#%name|
set-module-path-index-resolved!
(record-mutator struct:module-path-index 2)))
(define set-module-path-index-shift-cache!
(|#%name|
set-module-path-index-shift-cache!
(record-mutator struct:module-path-index 3)))
(define empty-shift-cache '())
(define deserialize-module-path-index
(case-lambda
((path_0 base_0) (1/module-path-index-join path_0 base_0))
((name_0)
(make-self-module-path-index (1/make-resolved-module-path name_0)))
(() top-level-module-path-index)))
(define 1/module-path-index-resolve
(let ((module-path-index-resolve_0
(|#%name|
module-path-index-resolve
(lambda (mpi4_0 load?3_0)
(begin
(begin
(if (1/module-path-index? mpi4_0)
(void)
(raise-argument-error
'module-path-index-resolve
"module-path-index?"
mpi4_0))
(let ((or-part_0 (module-path-index-resolved mpi4_0)))
(if or-part_0
or-part_0
(let ((mod-name_0
(begin
(if log-performance?
(start-performance-region 'eval 'resolver)
(void))
(begin0
(let ((app_0
(|#%app|
1/current-module-name-resolver)))
(|#%app|
app_0
(module-path-index-path mpi4_0)
(module-path-index-resolve/maybe
(module-path-index-base mpi4_0)
load?3_0)
#f
load?3_0))
(if log-performance?
(end-performance-region)
(void))))))
(begin
(if (1/resolved-module-path? mod-name_0)
(void)
(raise-arguments-error
'module-path-index-resolve
"current module name resolver's result is not a resolved module path"
"result"
mod-name_0))
(set-module-path-index-resolved! mpi4_0 mod-name_0)
mod-name_0))))))))))
(|#%name|
module-path-index-resolve
(case-lambda
((mpi_0) (begin (module-path-index-resolve_0 mpi_0 #f)))
((mpi_0 load?3_0) (module-path-index-resolve_0 mpi_0 load?3_0))))))
(define module-path-index-unresolve
(lambda (mpi_0)
(if (module-path-index-resolved mpi_0)
(call-with-values
(lambda () (1/module-path-index-split mpi_0))
(case-lambda
((path_0 base_0) (1/module-path-index-join path_0 base_0))
(args (raise-binding-result-arity-error 2 args))))
mpi_0)))
(define 1/module-path-index-join
(let ((module-path-index-join_0
(|#%name|
module-path-index-join
(lambda (mod-path6_0 base7_0 submod5_0)
(begin
(begin
(if (let ((or-part_0 (not mod-path6_0)))
(if or-part_0 or-part_0 (1/module-path? mod-path6_0)))
(void)
(raise-argument-error
'module-path-index-join
"(or/c #f module-path?)"
mod-path6_0))
(if (let ((or-part_0 (not base7_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (1/resolved-module-path? base7_0)))
(if or-part_1
or-part_1
(1/module-path-index? base7_0)))))
(void)
(raise-argument-error
'module-path-index-join
"(or/c #f resolved-module-path? module-path-index?)"
base7_0))
(if (let ((or-part_0 (not submod5_0)))
(if or-part_0
or-part_0
(if (pair? submod5_0)
(if (list? submod5_0)
(andmap_2344 symbol? submod5_0)
#f)
#f)))
(void)
(raise-argument-error
'module-path-index-join
"(or/c #f (non-empty-listof symbol?))"
submod5_0))
(if (if (not mod-path6_0) base7_0 #f)
(raise-arguments-error
'module-path-index-join
"cannot combine #f path with non-#f base"
"given base"
base7_0)
(void))
(if (if submod5_0 mod-path6_0 #f)
(raise-arguments-error
'module-path-index-join
"cannot combine #f submodule list with non-#f module path"
"given module path"
mod-path6_0
"given submodule list"
submod5_0)
(void))
(if submod5_0
(make-self-module-path-index
(1/make-resolved-module-path
(cons '|expanded module| submod5_0)))
(let ((keep-base_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (mod-path_0)
(begin
(if (path? mod-path_0)
#f
(if (if (pair? mod-path_0)
(eq? 'quote (car mod-path_0))
#f)
#f
(if (symbol? mod-path_0)
#f
(if (if (pair? mod-path_0)
(eq? 'submod (car mod-path_0))
#f)
(loop_0 (cadr mod-path_0))
base7_0)))))))))
(loop_0 mod-path6_0))))
(module-path-index2.1
mod-path6_0
keep-base_0
#f
'())))))))))
(|#%name|
module-path-index-join
(case-lambda
((mod-path_0 base_0)
(begin (module-path-index-join_0 mod-path_0 base_0 #f)))
((mod-path_0 base_0 submod5_0)
(module-path-index-join_0 mod-path_0 base_0 submod5_0))))))
(define module-path-index-resolve/maybe
(lambda (base_0 load?_0)
(if (1/module-path-index? base_0)
(1/module-path-index-resolve base_0 load?_0)
base_0)))
(define 1/module-path-index-split
(|#%name|
module-path-index-split
(lambda (mpi_0)
(begin
(begin
(if (1/module-path-index? mpi_0)
(void)
(raise-argument-error
'module-path-index-split
"module-path-index?"
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
(lambda (mpi_0)
(begin
(begin
(if (1/module-path-index? mpi_0)
(void)
(raise-argument-error
'module-path-index-submodule
"module-path-index?"
mpi_0))
(if (not (module-path-index-path mpi_0))
(let ((r_0 (module-path-index-resolved mpi_0)))
(if r_0
(let ((p_0 (1/resolved-module-path-name r_0)))
(if (pair? p_0) (cdr p_0) #f))
#f))
#f))))))
(define make-self-module-path-index
(case-lambda
((name_0) (module-path-index2.1 #f #f name_0 '()))
((name_0 enclosing_0)
(make-self-module-path-index
(let ((temp20_0
(if enclosing_0 (1/module-path-index-resolve enclosing_0) #f)))
(|#%app| build-module-name.1 unsafe-undefined name_0 temp20_0))))))
(define cell.1$8 (unsafe-make-place-local (make-weak-hash)))
(define generic-module-name '|expanded module|)
(define module-path-place-init!
(lambda () (unsafe-place-local-set! cell.1$8 (make-weak-hash))))
(define make-generic-self-module-path-index
(lambda (self_0)
(let ((r_0
(resolved-module-path-to-generic-resolved-module-path
(module-path-index-resolved self_0))))
(begin
(begin-unsafe (unsafe-start-atomic))
(begin0
(let ((or-part_0
(let ((e_0
(hash-ref (unsafe-place-local-ref cell.1$8) r_0 #f)))
(if e_0 (ephemeron-value e_0) #f))))
(if or-part_0
or-part_0
(let ((mpi_0 (module-path-index2.1 #f #f r_0 '())))
(begin
(hash-set!
(unsafe-place-local-ref cell.1$8)
r_0
(make-ephemeron r_0 mpi_0))
mpi_0))))
(begin-unsafe (unsafe-end-atomic)))))))
(define resolved-module-path-to-generic-resolved-module-path
(lambda (r_0)
(let ((name_0 (1/resolved-module-path-name r_0)))
(1/make-resolved-module-path
(if (symbol? name_0)
'|expanded module|
(cons '|expanded module| (cdr name_0)))))))
(define imitate-generic-module-path-index!
(lambda (mpi_0)
(let ((r_0 (module-path-index-resolved mpi_0)))
(if r_0
(set-module-path-index-resolved!
mpi_0
(resolved-module-path-to-generic-resolved-module-path r_0))
(void)))))
(define module-path-index-shift
(lambda (mpi_0 from-mpi_0 to-mpi_0)
(if (eq? mpi_0 from-mpi_0)
to-mpi_0
(let ((base_0 (module-path-index-base mpi_0)))
(if (not base_0)
mpi_0
(let ((shifted-base_0
(module-path-index-shift base_0 from-mpi_0 to-mpi_0)))
(if (eq? shifted-base_0 base_0)
mpi_0
(let ((c1_0
(shift-cache-ref
(module-path-index-shift-cache shifted-base_0)
mpi_0)))
(if c1_0
c1_0
(let ((shifted-mpi_0
(module-path-index2.1
(module-path-index-path mpi_0)
shifted-base_0
#f
'())))
(begin
(shift-cache-set! shifted-base_0 shifted-mpi_0)
shifted-mpi_0)))))))))))
(define shift-cache-ref
(lambda (cache_0 mpi_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((wb_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1
(let ((v_0 (weak-box-value wb_0)))
(if v_0
(if (equal?
(module-path-index-path v_0)
(module-path-index-path mpi_0))
v_0
#f)
#f))))
(values result_1))))
(if (if (not (let ((x_0 (list wb_0))) result_1)) #t #f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #f cache_0)))))
(define shift-cache-set!
(lambda (base_0 v_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 (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?
(lambda (mpi_0) (eq? top-level-module-path-index mpi_0)))
(define non-self-module-path-index?
(lambda (mpi_0) (if (module-path-index-path mpi_0) #t #f)))
(define inside-module-context?
(lambda (mpi_0 inside-mpi_0)
(let ((or-part_0 (eq? mpi_0 inside-mpi_0)))
(if or-part_0
or-part_0
(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)))
#f)
#f)
#f)))))
(define core-module-name-resolver
(case-lambda
((name_0 from-namespace_0) (void))
((p_0 enclosing_0 source-stx-stx_0 load?_0)
(begin
(if (1/module-path? p_0)
(void)
(raise-argument-error 'core-module-name-resolver "module-path?" p_0))
(if (let ((or-part_0 (not enclosing_0)))
(if or-part_0 or-part_0 (1/resolved-module-path? enclosing_0)))
(void)
(raise-argument-error
'core-module-name-resolver
"resolved-module-path?"
enclosing_0))
(if (if (list? p_0)
(if (= (length p_0) 2)
(if (eq? 'quote (car p_0)) (symbol? (cadr p_0)) #f)
#f)
#f)
(1/make-resolved-module-path (cadr p_0))
(if (if (list? p_0)
(if (eq? 'submod (car p_0)) (equal? ".." (cadr p_0)) #f)
#f)
(let ((lst_0 (cdr p_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (enclosing_1 lst_1)
(begin
(if (pair? lst_1)
(let ((s_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((enclosing_2
(let ((enclosing_2
(build-module-name.1
p_0
s_0
enclosing_1)))
(values enclosing_2))))
(for-loop_0 enclosing_2 rest_0))))
enclosing_1))))))
(for-loop_0 enclosing_0 lst_0))))
(if (if (list? p_0)
(if (eq? 'submod (car p_0)) (equal? "." (cadr p_0)) #f)
#f)
(let ((lst_0 (cddr p_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (enclosing_1 lst_1)
(begin
(if (pair? lst_1)
(let ((s_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((enclosing_2
(let ((enclosing_2
(build-module-name.1
p_0
s_0
enclosing_1)))
(values enclosing_2))))
(for-loop_0 enclosing_2 rest_0))))
enclosing_1))))))
(for-loop_0 enclosing_0 lst_0))))
(if (if (list? p_0) (eq? 'submod (car p_0)) #f)
(let ((base_0
(let ((app_0 (|#%app| 1/current-module-name-resolver)))
(|#%app| app_0 (cadr p_0) enclosing_0 #f #f))))
(let ((lst_0 (cddr p_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (enclosing_1 lst_1)
(begin
(if (pair? lst_1)
(let ((s_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((enclosing_2
(let ((enclosing_2
(build-module-name.1
p_0
s_0
enclosing_1)))
(values enclosing_2))))
(for-loop_0 enclosing_2 rest_0))))
enclosing_1))))))
(for-loop_0 base_0 lst_0)))))
(error
'core-module-name-resolver
"not a supported module path: ~v"
p_0)))))))))
(define build-module-name.1
(|#%name|
build-module-name
(lambda (original8_0 name10_0 enclosing11_0)
(begin
(let ((orig-name_0
(if (eq? original8_0 unsafe-undefined) name10_0 original8_0)))
(let ((enclosing-module-name_0
(if enclosing11_0
(1/resolved-module-path-name enclosing11_0)
#f)))
(1/make-resolved-module-path
(if (not enclosing-module-name_0)
name10_0
(if (symbol? enclosing-module-name_0)
(list enclosing-module-name_0 name10_0)
(if (equal? name10_0 "..")
(if (symbol? enclosing-module-name_0)
(error "too many \"..\"s:" orig-name_0)
(if (= 2 (length enclosing-module-name_0))
(car enclosing-module-name_0)
(reverse$1 (cdr (reverse$1 enclosing-module-name_0)))))
(append enclosing-module-name_0 (list name10_0))))))))))))
(define 1/current-module-name-resolver
(make-parameter
core-module-name-resolver
(lambda (v_0)
(begin
(if (if (procedure? v_0)
(if (procedure-arity-includes? v_0 2)
(procedure-arity-includes? v_0 4)
#f)
#f)
(void)
(raise-argument-error
'current-module-name-resolver
"(and/c (procedure-arity-includes/c 2) (procedure-arity-includes/c 4))"
v_0))
v_0))
'current-module-name-resolver))
(define 1/current-module-declare-name
(make-parameter
#f
(lambda (r_0)
(begin
(if (let ((or-part_0 (not r_0)))
(if or-part_0 or-part_0 (1/resolved-module-path? r_0)))
(void)
(raise-argument-error
'current-module-declare-name
"(or/c #f resolved-module-path?)"
r_0))
r_0))
'current-module-declare-name))
(define 1/current-module-declare-source
(make-parameter
#f
(lambda (s_0)
(begin
(if (let ((or-part_0 (not s_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (symbol? s_0)))
(if or-part_1
or-part_1
(if (path? s_0) (complete-path? s_0) #f)))))
(void)
(raise-argument-error
'current-module-declare-source
"(or/c #f symbol? (and/c path? complete-path?))"
s_0))
s_0))
'current-module-declare-source))
(define substitute-module-declare-name
(lambda (default-name_0)
(let ((current-name_0 (1/current-module-declare-name)))
(let ((root-name_0
(if current-name_0
(resolved-module-path-root-name current-name_0)
(if (pair? default-name_0)
(car default-name_0)
default-name_0))))
(1/make-resolved-module-path
(if (pair? default-name_0)
(cons root-name_0 (cdr default-name_0))
root-name_0))))))
(define struct:promise
(make-record-type-descriptor*
'promise
#f
(|#%nongenerative-uid| promise)
#f
#f
2
3))
(define effect_2288
(struct-type-install-properties!
struct:promise
'promise
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'promise))
(define promise1.1
(|#%name|
promise
(record-constructor
(make-record-constructor-descriptor struct:promise #f #f))))
(define promise? (|#%name| promise? (record-predicate struct:promise)))
(define promise-val (|#%name| promise-val (record-accessor struct:promise 0)))
(define promise-status
(|#%name| promise-status (record-accessor struct:promise 1)))
(define set-promise-val!
(|#%name| set-promise-val! (record-mutator struct:promise 0)))
(define set-promise-status!
(|#%name| set-promise-status! (record-mutator struct:promise 1)))
(define force
(lambda (v_0)
(if (promise? v_0)
(let ((s_0 (promise-status v_0)))
(if (not s_0)
(let ((result_0 (|#%app| (promise-val v_0))))
(begin
(set-promise-val! v_0 result_0)
(set-promise-status! v_0 #t)
result_0))
(promise-val v_0)))
v_0)))
(define phase?
(lambda (v_0)
(let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (exact-integer? v_0)))))
(define phase+ (lambda (a_0 b_0) (if a_0 (if b_0 (+ a_0 b_0) #f) #f)))
(define phase- (lambda (a_0 b_0) (if a_0 (if b_0 (- a_0 b_0) #f) #f)))
(define phase<?
(lambda (a_0 b_0) (if (not b_0) #f (if (not a_0) #t (< a_0 b_0)))))
(define zero-phase? (lambda (a_0) (eq? a_0 0)))
(define label-phase? (lambda (a_0) (not a_0)))
(define phase?-string "(or/c exact-integer? #f)")
(define make-small-hasheq (lambda () (box hash2610)))
(define make-small-hasheqv (lambda () (box hash2589)))
(define small-hash-ref
(lambda (small-ht_0 key_0 default_0)
(hash-ref (unbox small-ht_0) key_0 default_0)))
(define small-hash-set!
(lambda (small-ht_0 key_0 val_0)
(set-box! small-ht_0 (hash-set (unbox small-ht_0) key_0 val_0))))
(define small-hash-keys (lambda (small-ht_0) (hash-keys (unbox small-ht_0))))
(define struct:serialize-state
(make-record-type-descriptor*
'serialize-state
#f
(|#%nongenerative-uid| serialize-state)
#f
#f
12
0))
(define effect_2227
(struct-type-install-properties!
struct:serialize-state
'serialize-state
12
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9 10 11)
#f
'serialize-state))
(define serialize-state1.1
(|#%name|
serialize-state
(record-constructor
(make-record-constructor-descriptor struct:serialize-state #f #f))))
(define serialize-state?
(|#%name| serialize-state? (record-predicate struct:serialize-state)))
(define serialize-state-reachable-scopes
(|#%name|
serialize-state-reachable-scopes
(record-accessor struct:serialize-state 0)))
(define serialize-state-bindings-intern
(|#%name|
serialize-state-bindings-intern
(record-accessor struct:serialize-state 1)))
(define serialize-state-bulk-bindings-intern
(|#%name|
serialize-state-bulk-bindings-intern
(record-accessor struct:serialize-state 2)))
(define serialize-state-scopes
(|#%name| serialize-state-scopes (record-accessor struct:serialize-state 3)))
(define serialize-state-shifted-multi-scopes
(|#%name|
serialize-state-shifted-multi-scopes
(record-accessor struct:serialize-state 4)))
(define serialize-state-multi-scope-tables
(|#%name|
serialize-state-multi-scope-tables
(record-accessor struct:serialize-state 5)))
(define serialize-state-mpi-shifts
(|#%name|
serialize-state-mpi-shifts
(record-accessor struct:serialize-state 6)))
(define serialize-state-context-triples
(|#%name|
serialize-state-context-triples
(record-accessor struct:serialize-state 7)))
(define serialize-state-props
(|#%name| serialize-state-props (record-accessor struct:serialize-state 8)))
(define serialize-state-interned-props
(|#%name|
serialize-state-interned-props
(record-accessor struct:serialize-state 9)))
(define serialize-state-syntax-context
(|#%name|
serialize-state-syntax-context
(record-accessor struct:serialize-state 10)))
(define serialize-state-sharing-syntaxes
(|#%name|
serialize-state-sharing-syntaxes
(record-accessor struct:serialize-state 11)))
(define make-serialize-state
(lambda (reachable-scopes_0)
(let ((state_0
(let ((app_0 (make-hasheq)))
(let ((app_1 (make-hasheq)))
(let ((app_2 (make-hash)))
(let ((app_3 (make-hash)))
(let ((app_4 (make-hasheq)))
(let ((app_5 (make-hasheq)))
(let ((app_6 (make-hasheq)))
(let ((app_7 (make-hasheq)))
(let ((app_8 (make-hash)))
(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!
(serialize-state-scopes state_0)
empty-seteq_0
empty-seteq_0)
(hash-set!
(serialize-state-shifted-multi-scopes state_0)
empty-seteq_0
empty-seteq_0)
(hash-set!
(serialize-state-interned-props state_0)
empty-seteq_0
empty-seteq_0)
state_0)))))
(define intern-scopes
(lambda (scs_0 state_0)
(let ((or-part_0 (hash-ref (serialize-state-scopes state_0) scs_0 #f)))
(if or-part_0
or-part_0
(begin
(hash-set! (serialize-state-scopes state_0) scs_0 scs_0)
scs_0)))))
(define intern-shifted-multi-scopes
(lambda (sms_0 state_0)
(let ((or-part_0
(hash-ref (serialize-state-shifted-multi-scopes state_0) sms_0 #f)))
(if or-part_0
or-part_0
(begin
(hash-set!
(serialize-state-shifted-multi-scopes state_0)
sms_0
sms_0)
sms_0)))))
(define intern-mpi-shifts
(lambda (mpi-shifts_0 state_0)
(if (null? mpi-shifts_0)
null
(let ((tail_0 (intern-mpi-shifts (cdr mpi-shifts_0) state_0)))
(let ((tail-table_0
(let ((or-part_0
(hash-ref
(serialize-state-mpi-shifts state_0)
tail_0
#f)))
(if or-part_0
or-part_0
(let ((ht_0 (make-hasheq)))
(begin
(hash-set!
(serialize-state-mpi-shifts state_0)
tail_0
ht_0)
ht_0))))))
(let ((or-part_0 (hash-ref tail-table_0 (car mpi-shifts_0) #f)))
(if or-part_0
or-part_0
(let ((v_0 (cons (car mpi-shifts_0) tail_0)))
(begin
(hash-set! tail-table_0 (car mpi-shifts_0) v_0)
v_0)))))))))
(define intern-context-triple
(lambda (scs_0 sms_0 mpi-shifts_0 state_0)
(let ((scs-ht_0
(let ((or-part_0
(hash-ref
(serialize-state-context-triples state_0)
scs_0
#f)))
(if or-part_0
or-part_0
(let ((ht_0 (make-hasheq)))
(begin
(hash-set!
(serialize-state-context-triples state_0)
scs_0
ht_0)
ht_0))))))
(let ((sms-ht_0
(let ((or-part_0 (hash-ref scs-ht_0 sms_0 #f)))
(if or-part_0
or-part_0
(let ((ht_0 (make-hasheq)))
(begin (hash-set! scs-ht_0 sms_0 ht_0) ht_0))))))
(let ((or-part_0 (hash-ref sms-ht_0 mpi-shifts_0 #f)))
(if or-part_0
or-part_0
(let ((vec_0 (vector-immutable scs_0 sms_0 mpi-shifts_0)))
(begin (hash-set! sms-ht_0 mpi-shifts_0 vec_0) vec_0))))))))
(define intern-properties
(lambda (all-props_0 get-preserved-props_0 state_0)
(let ((v_0 (hash-ref (serialize-state-props state_0) all-props_0 'no)))
(if (eq? v_0 'no)
(let ((preserved-props_0 (|#%app| get-preserved-props_0)))
(let ((p_0
(if (zero? (hash-count preserved-props_0))
#f
(let ((c1_0
(hash-ref
(serialize-state-interned-props state_0)
preserved-props_0
#f)))
(if c1_0
c1_0
(begin
(hash-set!
(serialize-state-interned-props state_0)
preserved-props_0
preserved-props_0)
preserved-props_0))))))
(begin
(hash-set! (serialize-state-props state_0) all-props_0 p_0)
p_0)))
v_0))))
(define push-syntax-context!
(lambda (state_0 v_0)
(let ((b_0 (serialize-state-syntax-context state_0)))
(set-box! b_0 (cons v_0 (unbox b_0))))))
(define get-syntax-context
(lambda (state_0)
(let ((b_0 (serialize-state-syntax-context state_0)))
(if (null? (unbox b_0)) #f (car (unbox b_0))))))
(define pop-syntax-context!
(lambda (state_0)
(let ((b_0 (serialize-state-syntax-context state_0)))
(set-box! b_0 (cdr (unbox b_0))))))
(define root-tag (unsafe-root-continuation-prompt-tag))
(define default-val.1$2 #f)
(define current-module-code-inspector
(lambda ()
(continuation-mark-set-first
#f
current-module-code-inspector
#f
root-tag)))
(define immutable-prefab-struct-key
(lambda (v_0)
(let ((k_0 (prefab-struct-key v_0)))
(if k_0 (if (all-fields-immutable?$1 k_0) k_0 #f) #f))))
(define prefab-key-all-fields-immutable?
(lambda (k_0)
(begin
(if (prefab-key? k_0)
(void)
(raise-argument-error
'prefab-key-all-fields-immutable?
"prefab-key?"
k_0))
(all-fields-immutable?$1 k_0))))
(define all-fields-immutable?$1
(|#%name|
all-fields-immutable?
(lambda (k_0)
(begin
(let ((or-part_0 (symbol? k_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (null? k_0)))
(if or-part_1
or-part_1
(let ((rk_0 (cdr k_0)))
(let ((rk_1
(if (if (pair? rk_0) (exact-integer? (car rk_0)) #f)
(cdr rk_0)
rk_0)))
(let ((rk_2
(if (if (pair? rk_1) (pair? (car rk_1)) #f)
(if (zero? (caar rk_1))
(cdr rk_1)
(cons '#(1) (cdr rk_1)))
rk_1)))
(if (if (pair? rk_2) (vector? (car rk_2)) #f)
(if (zero? (vector-length (car rk_2)))
(all-fields-immutable?$1 (cdr rk_2))
#f)
(all-fields-immutable?$1 rk_2)))))))))))))
(define all-fields-immutable?
(lambda (k_0) (prefab-key-all-fields-immutable? k_0)))
(define datum-map-slow
(lambda (tail?_0 s_0 f_0 seen_0 known-pairs_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_1 s_1 prev-seen_0)
(begin
(let ((seen_1
(if (if prev-seen_0 (datum-has-elements? s_1) #f)
(if (hash-ref prev-seen_0 s_1 #f)
(|#%app| (hash-ref prev-seen_0 'cycle-fail) s_1)
(hash-set prev-seen_0 s_1 #t))
prev-seen_0)))
(if (null? s_1)
(|#%app| f_0 tail?_1 s_1)
(if (pair? s_1)
(if (if known-pairs_0
(if tail?_1 (hash-ref known-pairs_0 s_1 #f) #f)
#f)
s_1
(|#%app|
f_0
tail?_1
(let ((app_0 (loop_0 #f (car s_1) seen_1)))
(cons
app_0
(let ((app_1 (if tail?_1 (fx+ 1 tail?_1) 1)))
(loop_0 app_1 (cdr s_1) seen_1))))))
(if (let ((or-part_0 (symbol? s_1)))
(if or-part_0
or-part_0
(let ((or-part_1 (boolean? s_1)))
(if or-part_1 or-part_1 (number? s_1)))))
(|#%app| f_0 #f s_1)
(if (vector? s_1)
(|#%app|
f_0
#f
(vector->immutable-vector
(let ((len_0 (vector-length s_1)))
(begin
(if (exact-nonnegative-integer? len_0)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_0))
(let ((v_0 (make-vector len_0 0)))
(begin
(if (zero? len_0)
(void)
(call-with-values
(lambda ()
(begin
(check-vector s_1)
(values
s_1
(unsafe-vector-length s_1))))
(case-lambda
((vec_0 len_1)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_1)
(let ((e_0
(unsafe-vector-ref
vec_0
pos_0)))
(let ((i_1
(let ((i_1
(begin
(unsafe-vector*-set!
v_0
i_0
(loop_0
#f
e_0
seen_1))
(unsafe-fx+
1
i_0))))
(values i_1))))
(if (if (not
(let ((x_0
(list
e_0)))
(unsafe-fx=
i_1
len_0)))
#t
#f)
(for-loop_0
i_1
(unsafe-fx+ 1 pos_0))
i_1)))
i_0))))))
(for-loop_0 0 0))))
(args
(raise-binding-result-arity-error
2
args)))))
v_0))))))
(if (box? s_1)
(|#%app|
f_0
#f
(box-immutable (loop_0 #f (unbox s_1) seen_1)))
(let ((c1_0 (immutable-prefab-struct-key s_1)))
(if c1_0
(|#%app|
f_0
#f
(apply
make-prefab-struct
c1_0
(reverse$1
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
(struct->vector s_1)
1
#f
1))
(case-lambda
((v*_0 start*_0 stop*_0 step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 idx_0)
(begin
(if (unsafe-fx< idx_0 stop*_0)
(let ((e_0
(unsafe-vector-ref
v*_0
idx_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(loop_0
#f
e_0
seen_1)
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
(unsafe-fx+ idx_0 1))))
fold-var_0))))))
(for-loop_0 null start*_0))))
(args
(raise-binding-result-arity-error
4
args)))))))
(if (if (hash? s_1) (immutable? s_1) #f)
(if (hash-eq? s_1)
(|#%app|
f_0
#f
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
s_1
i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(loop_0
#f
v_0
seen_1)))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next
s_1
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2610
(hash-iterate-first s_1)))))
(if (hash-eqv? s_1)
(|#%app|
f_0
#f
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
s_1
i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(loop_0
#f
v_0
seen_1)))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next
s_1
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2589
(hash-iterate-first s_1)))))
(|#%app|
f_0
#f
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
s_1
i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(loop_0
#f
v_0
seen_1)))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next
s_1
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2725
(hash-iterate-first s_1)))))))
(|#%app| f_0 #f s_1)))))))))))))))
(loop_0 tail?_0 s_0 seen_0))))
(define datum-has-elements?
(lambda (d_0)
(let ((or-part_0 (pair? d_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (vector? d_0)))
(if or-part_1
or-part_1
(let ((or-part_2 (box? d_0)))
(if or-part_2
or-part_2
(let ((or-part_3 (immutable-prefab-struct-key d_0)))
(if or-part_3
or-part_3
(if (hash? d_0)
(if (immutable? d_0) (positive? (hash-count d_0)) #f)
#f)))))))))))
(define struct:preserved-property-value
(make-record-type-descriptor*
'preserved-property-value
#f
(|#%nongenerative-uid| preserved-property-value)
#f
#f
1
0))
(define effect_2975
(struct-type-install-properties!
struct:preserved-property-value
'preserved-property-value
1
0
#f
null
(current-inspector)
#f
'(0)
#f
'preserved-property-value))
(define preserved-property-value1.1
(|#%name|
preserved-property-value
(record-constructor
(make-record-constructor-descriptor
struct:preserved-property-value
#f
#f))))
(define preserved-property-value?_2252
(|#%name|
preserved-property-value?
(record-predicate struct:preserved-property-value)))
(define preserved-property-value?
(|#%name|
preserved-property-value?
(lambda (v)
(if (preserved-property-value?_2252 v)
#t
($value
(if (impersonator? v)
(preserved-property-value?_2252 (impersonator-val v))
#f))))))
(define preserved-property-value-content_2497
(|#%name|
preserved-property-value-content
(record-accessor struct:preserved-property-value 0)))
(define preserved-property-value-content
(|#%name|
preserved-property-value-content
(lambda (s)
(if (preserved-property-value?_2252 s)
(preserved-property-value-content_2497 s)
($value
(impersonate-ref
preserved-property-value-content_2497
struct:preserved-property-value
0
s
'preserved-property-value
'content))))))
(define plain-property-value
(lambda (v_0)
(if (preserved-property-value? v_0)
(preserved-property-value-content v_0)
v_0)))
(define check-value-to-preserve
(lambda (v_0 syntax?_0)
(let ((check-preserve_0
(|#%name|
check-preserve
(lambda (tail?_0 v_1)
(begin
(begin
(if (let ((or-part_0 (null? v_1)))
(if or-part_0
or-part_0
(let ((or-part_1 (boolean? v_1)))
(if or-part_1
or-part_1
(let ((or-part_2 (symbol? v_1)))
(if or-part_2
or-part_2
(let ((or-part_3 (number? v_1)))
(if or-part_3
or-part_3
(let ((or-part_4 (char? v_1)))
(if or-part_4
or-part_4
(let ((or-part_5 (string? v_1)))
(if or-part_5
or-part_5
(let ((or-part_6 (bytes? v_1)))
(if or-part_6
or-part_6
(let ((or-part_7
(regexp? v_1)))
(if or-part_7
or-part_7
(let ((or-part_8
(|#%app|
syntax?_0
v_1)))
(if or-part_8
or-part_8
(let ((or-part_9
(pair? v_1)))
(if or-part_9
or-part_9
(let ((or-part_10
(vector?
v_1)))
(if or-part_10
or-part_10
(let ((or-part_11
(box?
v_1)))
(if or-part_11
or-part_11
(let ((or-part_12
(hash?
v_1)))
(if or-part_12
or-part_12
(immutable-prefab-struct-key
v_1)))))))))))))))))))))))))))
(void)
(raise-arguments-error
'write
"disallowed value in preserved syntax property"
"value"
v_1))
v_1))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 s_0 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (if disallow-cycles$1 (fx> depth_0 32) #f)
(datum-map-slow
tail?_0
s_0
(lambda (tail?_1 s_1) (check-preserve_0 tail?_1 s_1))
disallow-cycles$1
#f)
(if (null? s_0)
(check-preserve_0 tail?_0 s_0)
(if (pair? s_0)
(check-preserve_0
tail?_0
(let ((app_0 (loop_0 #f (car s_0) depth_0)))
(cons app_0 (loop_0 1 (cdr s_0) depth_0))))
(if (symbol? s_0)
(check-preserve_0 #f s_0)
(if (boolean? s_0)
(check-preserve_0 #f s_0)
(if (number? s_0)
(check-preserve_0 #f s_0)
(if (let ((or-part_0 (vector? s_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (box? s_0)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key s_0)))
(if or-part_2
or-part_2
(hash? s_0)))))))
(datum-map-slow
tail?_0
s_0
(lambda (tail?_1 s_1)
(check-preserve_0 tail?_1 s_1))
disallow-cycles$1
#f)
(check-preserve_0 #f s_0))))))))))))))
(loop_0 #f v_0 0)))))
(define disallow-cycles$1
(hash
'cycle-fail
(lambda (v_0)
(raise-arguments-error
'write
"disallowed cycle in preserved syntax property"
"at"
v_0))))
(define tamper?
(lambda (v_0)
(let ((or-part_0 (not v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (symbol? v_0)))
(if or-part_1 or-part_1 (begin-unsafe (hash? v_0))))))))
(define tamper-tainted? (lambda (v_0) (symbol? v_0)))
(define tamper-armed? (lambda (v_0) (begin-unsafe (hash? v_0))))
(define tamper-clean? (lambda (v_0) (not v_0)))
(define tamper-tainted-for-content
(lambda (v_0)
(if (datum-has-elements? v_0) 'tainted/need-propagate 'tainted)))
(define tamper-needs-propagate?
(lambda (t_0) (eq? t_0 'tainted/need-propagate)))
(define tamper-propagated
(lambda (t_0) (if (eq? t_0 'tainted/need-propagate) 'tainted t_0)))
(define serialize-tamper
(lambda (t_0) (if (begin-unsafe (begin-unsafe (hash? t_0))) 'armed t_0)))
(define current-arm-inspectors
(make-parameter (seteq) #f 'current-arm-inspectors))
(define deserialize-tamper
(lambda (t_0) (if (eq? t_0 'armed) (current-arm-inspectors) t_0)))
(define struct:modified-content
(make-record-type-descriptor*
'modified-content
#f
(|#%nongenerative-uid| modified-content)
#f
#f
2
0))
(define effect_2941
(struct-type-install-properties!
struct:modified-content
'modified-content
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'modified-content))
(define modified-content1.1
(|#%name|
modified-content
(record-constructor
(make-record-constructor-descriptor struct:modified-content #f #f))))
(define modified-content?
(|#%name| modified-content? (record-predicate struct:modified-content)))
(define modified-content-content
(|#%name|
modified-content-content
(record-accessor struct:modified-content 0)))
(define modified-content-scope-propagations+tamper
(|#%name|
modified-content-scope-propagations+tamper
(record-accessor struct:modified-content 1)))
(define struct:syntax
(make-record-type-descriptor*
'syntax
#f
(|#%nongenerative-uid| syntax)
#f
#f
7
1))
(define effect_2357
(struct-type-install-properties!
struct:syntax
'syntax
7
0
#f
(list
(cons prop:authentic #t)
(cons
prop:reach-scopes
(lambda (s_0 reach_0)
(let ((content*_0 (syntax-content* s_0)))
(begin
(|#%app|
reach_0
(if (modified-content? content*_0)
(let ((prop_0
(modified-content-scope-propagations+tamper content*_0)))
(if (propagation?$1 prop_0)
(|#%app| (propagation-ref prop_0) s_0)
(modified-content-content content*_0)))
content*_0))
(|#%app| reach_0 (syntax-scopes s_0))
(|#%app| reach_0 (syntax-shifted-multi-scopes s_0))
(let ((ht_0 (syntax-props s_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 v_0)
(call-with-values
(lambda ()
(if (preserved-property-value? v_0)
(begin
(|#%app| reach_0 (plain-property-value v_0))
(values))
(values)))
(case-lambda
(()
(for-loop_0
(unsafe-immutable-hash-iterate-next ht_0 i_0)))
(args
(raise-binding-result-arity-error 0 args)))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (unsafe-immutable-hash-iterate-first ht_0)))))
(void)
(|#%app| reach_0 (syntax-srcloc s_0))))))
(cons
prop:serialize
(lambda (s_0 ser-push!_0 state_0)
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(let ((prop_0
(modified-content-scope-propagations+tamper
content*_0)))
(if (propagation?$1 prop_0)
(|#%app| (propagation-ref prop_0) s_0)
(modified-content-content content*_0)))
content*_0)))
(let ((properties_0
(intern-properties
(syntax-props s_0)
(lambda ()
(let ((ht_0 (syntax-props s_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(if (preserved-property-value?
v_0)
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(check-value-to-preserve
(plain-property-value
v_0)
syntax?$1)))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))
table_0)))
(for-loop_0
table_1
(hash-iterate-next ht_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0 hash2610 (hash-iterate-first ht_0))))))
state_0)))
(let ((tamper_0 (serialize-tamper (syntax-tamper s_0))))
(let ((context-triple_0
(let ((app_0
(intern-scopes (syntax-scopes s_0) state_0)))
(let ((app_1
(intern-shifted-multi-scopes
(syntax-shifted-multi-scopes s_0)
state_0)))
(intern-context-triple
app_0
app_1
(intern-mpi-shifts (syntax-mpi-shifts s_0) state_0)
state_0)))))
(let ((stx-state_0 (get-syntax-context state_0)))
(if (if properties_0 properties_0 tamper_0)
(begin
(|#%app| ser-push!_0 'tag kw2226)
(push-syntax-context! state_0 #f)
(|#%app| ser-push!_0 content_0)
(pop-syntax-context! state_0)
(|#%app| ser-push!_0 'reference context-triple_0)
(|#%app| ser-push!_0 'reference (syntax-srcloc s_0))
(|#%app| ser-push!_0 properties_0)
(|#%app| ser-push!_0 tamper_0)
(if stx-state_0
(set-syntax-state-all-sharing?! stx-state_0 #f)
(void)))
(let ((sharing-mode_0
(hash-ref
(serialize-state-sharing-syntaxes state_0)
s_0
'unknown)))
(begin
(if (eq? sharing-mode_0 'share)
(begin
(|#%app| ser-push!_0 'tag kw2099)
(|#%app| ser-push!_0 (syntax->datum$1 s_0)))
(if (eq? sharing-mode_0 'unknown)
(begin
(|#%app| ser-push!_0 'tag kw2641)
(let ((this-state_0
(if (no-pair-syntax-in-cdr? content_0)
(syntax-state17.1
#t
context-triple_0
(syntax-srcloc s_0))
#f)))
(begin
(push-syntax-context! state_0 this-state_0)
(begin
(|#%app| ser-push!_0 content_0)
(begin
(pop-syntax-context! state_0)
(let ((new-sharing-mode_0
(if (if this-state_0
(syntax-state-all-sharing?
this-state_0)
#f)
'share
'none)))
(begin
(hash-set!
(serialize-state-sharing-syntaxes
state_0)
s_0
(if (datum-has-elements? content_0)
new-sharing-mode_0
'none))
(if (if stx-state_0
(eq? new-sharing-mode_0 'none)
#f)
(set-syntax-state-all-sharing?!
stx-state_0
#f)
(void)))))))))
(begin
(|#%app| ser-push!_0 'tag kw2641)
(push-syntax-context! state_0 #f)
(|#%app| ser-push!_0 content_0)
(pop-syntax-context! state_0))))
(|#%app| ser-push!_0 'reference context-triple_0)
(|#%app| ser-push!_0 'reference (syntax-srcloc s_0))
(if stx-state_0
(if (if (eq?
context-triple_0
(syntax-state-context-triple 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))
(void)))))))))))))
(cons
prop:custom-write
(lambda (s_0 port_0 mode_0)
(begin
(write-string "#<syntax" port_0)
(let ((srcloc_0 (syntax-srcloc s_0)))
(begin
(if srcloc_0
(let ((srcloc-str_0 (srcloc->string srcloc_0)))
(if srcloc-str_0 (fprintf port_0 ":~a" srcloc-str_0) (void)))
(void))
(fprintf port_0 " ~.s" (syntax->datum$1 s_0))
(write-string ">" port_0)))))))
(current-inspector)
#f
'(1 2 3 4 5 6)
#f
'syntax))
(define syntax2.1
(|#%name|
syntax
(record-constructor
(make-record-constructor-descriptor struct:syntax #f #f))))
(define syntax?$1 (|#%name| syntax? (record-predicate struct:syntax)))
(define syntax-content*
(|#%name| syntax-content* (record-accessor struct:syntax 0)))
(define syntax-scopes
(|#%name| syntax-scopes (record-accessor struct:syntax 1)))
(define syntax-shifted-multi-scopes
(|#%name| syntax-shifted-multi-scopes (record-accessor struct:syntax 2)))
(define syntax-mpi-shifts
(|#%name| syntax-mpi-shifts (record-accessor struct:syntax 3)))
(define syntax-srcloc
(|#%name| syntax-srcloc (record-accessor struct:syntax 4)))
(define syntax-props (|#%name| syntax-props (record-accessor struct:syntax 5)))
(define syntax-inspector
(|#%name| syntax-inspector (record-accessor struct:syntax 6)))
(define set-syntax-content*!
(|#%name| set-syntax-content*! (record-mutator struct:syntax 0)))
(define-values
(prop:propagation propagation?$1 propagation-ref)
(make-struct-type-property 'propagation))
(define-values
(prop:propagation-tamper propagation-tamper? propagation-tamper-ref)
(make-struct-type-property 'propagation-tamper))
(define-values
(prop:propagation-set-tamper
propagation-set-tamper?
propagation-set-tamper-ref)
(make-struct-type-property 'propagation-set-tamper))
(define syntax-content
(lambda (s_0)
(let ((content*_0 (syntax-content* s_0)))
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0))))
(define syntax-tamper
(lambda (s_0)
(let ((content*_0 (syntax-content* s_0)))
(if (modified-content? content*_0)
(let ((v_0 (modified-content-scope-propagations+tamper content*_0)))
(if (tamper? v_0) v_0 (|#%app| (propagation-tamper-ref v_0) v_0)))
#f))))
(define syntax-content*-cas!
(lambda (stx_0 old_0 new_0) (unsafe-struct*-cas! stx_0 0 old_0 new_0)))
(define re-modify-content
(lambda (s_0 d_0)
(let ((content*_0 (syntax-content* s_0)))
(if (modified-content? content*_0)
(modified-content1.1
d_0
(modified-content-scope-propagations+tamper content*_0))
d_0))))
(define empty-scopes (seteq))
(define empty-shifted-multi-scopes (seteq))
(define empty-mpi-shifts null)
(define empty-props hash2610)
(define empty-syntax
(syntax2.1
#f
empty-scopes
empty-shifted-multi-scopes
null
#f
empty-props
#f))
(define identifier?
(lambda (s_0) (if (syntax?$1 s_0) (symbol? (syntax-content s_0)) #f)))
(define syntax-identifier? (lambda (s_0) (symbol? (syntax-content s_0))))
(define syntax->datum$1
(|#%name|
syntax->datum
(lambda (s_0)
(begin
(let ((f_0 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))))
(let ((d->s_0 (|#%name| d->s (lambda (s_1 d_0) (begin d_0)))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(let ((d_0 (loop_0 (syntax-content v_0))))
(begin-unsafe (begin d_0)))
(begin-unsafe (begin v_0))))))))
(letrec*
((loop_1
(|#%name|
loop
(lambda (tail?_0 s_2 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (null? s_2)
(begin-unsafe (begin s_2))
(if (pair? s_2)
(let ((x_0
(let ((app_0
(loop_1
#f
(car s_2)
depth_0)))
(cons
app_0
(loop_1 1 (cdr s_2) depth_0)))))
(begin-unsafe (begin x_0)))
(if (symbol? s_2)
(begin-unsafe (begin s_2))
(if (boolean? s_2)
(begin-unsafe (begin s_2))
(if (number? s_2)
(begin-unsafe (begin s_2))
(if (let ((or-part_0 (vector? s_2)))
(if or-part_0
or-part_0
(let ((or-part_1
(box? s_2)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_2)))
(if or-part_2
or-part_2
(hash? s_2)))))))
(datum-map-slow
tail?_0
s_2
(lambda (tail?_1 s_3)
(gf_0 tail?_1 s_3))
#f
#f)
(gf_0 #f s_2)))))))))))))
(loop_1 #f s_1 0)))))))))
(loop_0 s_0))))))))
(define cell.1$7 (unsafe-make-place-local (make-weak-hasheq)))
(define immediate-datum->syntax
(lambda (stx-c_0 content_0 stx-l_0 props_0 insp_0)
(let ((app_0
(if (if stx-c_0 (syntax-tamper stx-c_0) #f)
(modified-content1.1
content_0
(tamper-tainted-for-content content_0))
content_0)))
(let ((app_1 (if stx-c_0 (syntax-scopes stx-c_0) empty-scopes)))
(let ((app_2
(if stx-c_0
(syntax-shifted-multi-scopes stx-c_0)
empty-shifted-multi-scopes)))
(let ((app_3 (if stx-c_0 (syntax-mpi-shifts stx-c_0) null)))
(let ((app_4 (if stx-l_0 (syntax-srcloc stx-l_0) #f)))
(syntax2.1
app_0
app_1
app_2
app_3
app_4
props_0
(if insp_0
(if stx-c_0
(let ((b_0 (syntax-inspector stx-c_0)))
(if (eq? insp_0 b_0)
insp_0
(if (not insp_0)
#f
(if (not b_0)
#f
(if (inspector-superior? insp_0 b_0)
b_0
(if (inspector-superior? b_0 insp_0)
insp_0
#f))))))
#f)
#f)))))))))
(define datum->syntax$1
(let ((datum->syntax_0
(|#%name|
datum->syntax
(lambda (stx-c5_0 s6_0 stx-l3_0 stx-p4_0)
(begin
(if (syntax?$1 s6_0)
s6_0
(let ((insp_0
(if (syntax?$1 s6_0)
'not-needed
(current-module-code-inspector))))
(let ((wrap_0
(|#%name|
wrap
(lambda (content_0)
(begin
(let ((content_1
(datum-intern-literal content_0)))
(immediate-datum->syntax
stx-c5_0
content_1
stx-l3_0
empty-props
insp_0)))))))
(let ((f_0
(|#%name|
f
(lambda (tail?_0 x_0)
(begin
(if tail?_0
(begin
(if (if (fx> tail?_0 32)
(fx=
0
(fxand tail?_0 (fx- tail?_0 1)))
#f)
(hash-set!
(unsafe-place-local-ref cell.1$7)
x_0
#t)
(void))
x_0)
(wrap_0 x_0)))))))
(let ((result-s_0
(let ((s->_0
(|#%name| s-> (lambda (s_0) (begin s_0)))))
(let ((known-pairs_0
(unsafe-place-local-ref cell.1$7)))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(begin-unsafe (begin v_0))
(f_0 tail?_0 v_0)))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 s_0 prev-depth_0)
(begin
(let ((depth_0
(fx+ 1 prev-depth_0)))
(if (if disallow-cycles
(fx> depth_0 32)
#f)
(datum-map-slow
tail?_0
s_0
(lambda (tail?_1 s_1)
(gf_0 tail?_1 s_1))
disallow-cycles
known-pairs_0)
(if (null? s_0)
(f_0 tail?_0 s_0)
(if (pair? s_0)
(f_0
tail?_0
(let ((app_0
(loop_0
#f
(car s_0)
depth_0)))
(cons
app_0
(loop_0
1
(cdr s_0)
depth_0))))
(if (symbol? s_0)
(f_0 #f s_0)
(if (boolean? s_0)
(f_0 #f s_0)
(if (number? s_0)
(f_0 #f s_0)
(if (let ((or-part_0
(vector?
s_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(box?
s_0)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_0)))
(if or-part_2
or-part_2
(hash?
s_0)))))))
(datum-map-slow
tail?_0
s_0
(lambda (tail?_1
s_1)
(gf_0
tail?_1
s_1))
disallow-cycles
known-pairs_0)
(gf_0
#f
s_0))))))))))))))
(loop_0 #f s6_0 0)))))))
(if (if stx-p4_0
(not (eq? (syntax-props stx-p4_0) empty-props))
#f)
(if (syntax?$1 result-s_0)
(let ((props20_0 (syntax-props stx-p4_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?"
result-s_0))
result-s_0)))))))))))
(|#%name|
datum->syntax
(case-lambda
((stx-c_0 s_0) (begin (datum->syntax_0 stx-c_0 s_0 #f #f)))
((stx-c_0 s_0 stx-l_0 stx-p4_0)
(datum->syntax_0 stx-c_0 s_0 stx-l_0 stx-p4_0))
((stx-c_0 s_0 stx-l3_0) (datum->syntax_0 stx-c_0 s_0 stx-l3_0 #f))))))
(define disallow-cycles
(hasheq
'cycle-fail
(lambda (s_0)
(raise-arguments-error
'datum->syntax
"cannot create syntax from cyclic datum"
"datum"
s_0))))
(define syntax-place-init!
(lambda () (unsafe-place-local-set! cell.1$7 (make-weak-hasheq))))
(define struct:syntax-state
(make-record-type-descriptor*
'syntax-state
#f
(|#%nongenerative-uid| syntax-state)
#f
#f
3
1))
(define effect_2807
(struct-type-install-properties!
struct:syntax-state
'syntax-state
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(1 2)
#f
'syntax-state))
(define syntax-state17.1
(|#%name|
syntax-state
(record-constructor
(make-record-constructor-descriptor struct:syntax-state #f #f))))
(define syntax-state?
(|#%name| syntax-state? (record-predicate struct:syntax-state)))
(define syntax-state-all-sharing?
(|#%name| syntax-state-all-sharing? (record-accessor struct:syntax-state 0)))
(define syntax-state-context-triple
(|#%name|
syntax-state-context-triple
(record-accessor struct:syntax-state 1)))
(define syntax-state-srcloc
(|#%name| syntax-state-srcloc (record-accessor struct:syntax-state 2)))
(define set-syntax-state-all-sharing?!
(|#%name|
set-syntax-state-all-sharing?!
(record-mutator struct:syntax-state 0)))
(define no-pair-syntax-in-cdr?
(lambda (content_0)
(if (pair? content_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (content_1)
(begin
(if (if (syntax?$1 content_1)
(pair? (syntax-content content_1))
#f)
#f
(if (pair? content_1) (loop_0 (cdr content_1)) #t)))))))
(loop_0 (cdr content_0)))
#t)))
(define deserialize-syntax
(lambda (content_0 context-triple_0 srcloc_0 props_0 tamper_0 inspector_0)
(let ((app_0
(let ((t_0 (deserialize-tamper tamper_0)))
(if t_0 (modified-content1.1 content_0 t_0) content_0))))
(let ((app_1 (unsafe-vector*-ref context-triple_0 0)))
(let ((app_2 (unsafe-vector*-ref context-triple_0 1)))
(let ((app_3 (unsafe-vector*-ref context-triple_0 2)))
(syntax2.1
app_0
app_1
app_2
app_3
srcloc_0
(if props_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
props_0
i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(preserved-property-value1.1
v_0)))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next
props_0
i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0
hash2610
(unsafe-immutable-hash-iterate-first props_0))))
empty-props)
inspector_0)))))))
(define deserialize-datum->syntax
(lambda (content_0 context-triple_0 srcloc_0 inspector_0)
(let ((s_0
(deserialize-syntax
#f
context-triple_0
srcloc_0
#f
#f
inspector_0)))
(datum->syntax$1 s_0 content_0 s_0 s_0))))
(define struct:full-binding
(make-record-type-descriptor*
'full-binding
#f
(|#%nongenerative-uid| full-binding)
#f
#f
2
0))
(define effect_2547
(struct-type-install-properties!
struct:full-binding
'full-binding
2
0
#f
(list
(cons prop:authentic #t)
(cons prop:binding-reach-scopes (lambda (b_0) (binding-free=id b_0))))
(current-inspector)
#f
'(0 1)
#f
'full-binding))
(define full-binding1.1
(|#%name|
full-binding
(record-constructor
(make-record-constructor-descriptor struct:full-binding #f #f))))
(define full-binding?
(|#%name| full-binding? (record-predicate struct:full-binding)))
(define full-binding-frame-id
(|#%name| full-binding-frame-id (record-accessor struct:full-binding 0)))
(define full-binding-free=id
(|#%name| full-binding-free=id (record-accessor struct:full-binding 1)))
(define binding-frame-id
(lambda (b_0) (if (full-binding? b_0) (full-binding-frame-id b_0) #f)))
(define binding-free=id
(lambda (b_0) (if (full-binding? b_0) (full-binding-free=id b_0) #f)))
(define make-module-binding.1
(|#%name|
make-module-binding
(lambda (extra-inspector7_0
extra-nominal-bindings8_0
frame-id5_0
free=id6_0
nominal-module1_0
nominal-phase2_0
nominal-require-phase4_0
nominal-sym3_0
module17_0
phase18_0
sym19_0)
(begin
(let ((nominal-module_0
(if (eq? nominal-module1_0 unsafe-undefined)
module17_0
nominal-module1_0)))
(let ((nominal-phase_0
(if (eq? nominal-phase2_0 unsafe-undefined)
phase18_0
nominal-phase2_0)))
(let ((nominal-sym_0
(if (eq? nominal-sym3_0 unsafe-undefined)
sym19_0
nominal-sym3_0)))
(if (if frame-id5_0
frame-id5_0
(if free=id6_0
free=id6_0
(if extra-inspector7_0
extra-inspector7_0
(not
(if (eqv? nominal-phase_0 phase18_0)
(if (eq? nominal-sym_0 sym19_0)
(if (eqv? nominal-require-phase4_0 0)
(null? extra-nominal-bindings8_0)
#f)
#f)
#f)))))
(full-module-binding45.1
frame-id5_0
free=id6_0
module17_0
phase18_0
sym19_0
nominal-module_0
nominal-phase_0
nominal-sym_0
nominal-require-phase4_0
extra-inspector7_0
extra-nominal-bindings8_0)
(simple-module-binding46.1
module17_0
phase18_0
sym19_0
nominal-module_0)))))))))
(define module-binding-update.1
(|#%name|
module-binding-update
(lambda (extra-inspector30_0
extra-nominal-bindings31_0
frame-id28_0
free=id29_0
module21_0
nominal-module24_0
nominal-phase25_0
nominal-require-phase27_0
nominal-sym26_0
phase22_0
sym23_0
b43_0)
(begin
(let ((module_0
(if (eq? module21_0 unsafe-undefined)
(module-binding-module b43_0)
module21_0)))
(let ((phase_0
(if (eq? phase22_0 unsafe-undefined)
(module-binding-phase b43_0)
phase22_0)))
(let ((sym_0
(if (eq? sym23_0 unsafe-undefined)
(module-binding-sym b43_0)
sym23_0)))
(let ((nominal-module_0
(if (eq? nominal-module24_0 unsafe-undefined)
(module-binding-nominal-module b43_0)
nominal-module24_0)))
(let ((nominal-phase_0
(if (eq? nominal-phase25_0 unsafe-undefined)
(module-binding-nominal-phase b43_0)
nominal-phase25_0)))
(let ((nominal-sym_0
(if (eq? nominal-sym26_0 unsafe-undefined)
(module-binding-nominal-sym b43_0)
nominal-sym26_0)))
(let ((nominal-require-phase_0
(if (eq? nominal-require-phase27_0 unsafe-undefined)
(module-binding-nominal-require-phase b43_0)
nominal-require-phase27_0)))
(let ((frame-id_0
(if (eq? frame-id28_0 unsafe-undefined)
(binding-frame-id b43_0)
frame-id28_0)))
(let ((free=id_0
(if (eq? free=id29_0 unsafe-undefined)
(binding-free=id b43_0)
free=id29_0)))
(let ((extra-inspector_0
(if (eq? extra-inspector30_0 unsafe-undefined)
(module-binding-extra-inspector b43_0)
extra-inspector30_0)))
(let ((extra-nominal-bindings_0
(if (eq?
extra-nominal-bindings31_0
unsafe-undefined)
(module-binding-extra-nominal-bindings
b43_0)
extra-nominal-bindings31_0)))
(make-module-binding.1
extra-inspector_0
extra-nominal-bindings_0
frame-id_0
free=id_0
nominal-module_0
nominal-phase_0
nominal-require-phase_0
nominal-sym_0
module_0
phase_0
sym_0))))))))))))))))
(define module-binding?
(lambda (b_0)
(let ((or-part_0 (simple-module-binding? b_0)))
(if or-part_0 or-part_0 (full-module-binding? b_0)))))
(define struct:full-module-binding
(make-record-type-descriptor*
'full-module-binding
struct:full-binding
(|#%nongenerative-uid| full-module-binding)
#f
#f
9
0))
(define effect_2899
(struct-type-install-properties!
struct:full-module-binding
'full-module-binding
9
0
struct:full-binding
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (b_0 ser-push!_0 state_0)
(let ((simplified-b_0
(if (full-binding-frame-id b_0)
(module-binding-update.1
unsafe-undefined
unsafe-undefined
#f
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
b_0)
b_0)))
(if (full-module-binding? simplified-b_0)
(begin
(|#%app| ser-push!_0 'tag kw2804)
(|#%app| ser-push!_0 (full-module-binding-module b_0))
(|#%app| ser-push!_0 (full-module-binding-sym b_0))
(|#%app| ser-push!_0 (full-module-binding-phase b_0))
(|#%app| ser-push!_0 (full-module-binding-nominal-module b_0))
(|#%app| ser-push!_0 (full-module-binding-nominal-phase b_0))
(|#%app| ser-push!_0 (full-module-binding-nominal-sym b_0))
(|#%app|
ser-push!_0
(full-module-binding-nominal-require-phase b_0))
(|#%app| ser-push!_0 (full-binding-free=id b_0))
(if (full-module-binding-extra-inspector b_0)
(|#%app| ser-push!_0 'tag kw1932)
(|#%app| ser-push!_0 #f))
(|#%app|
ser-push!_0
(full-module-binding-extra-nominal-bindings b_0)))
(|#%app| ser-push!_0 simplified-b_0))))))
#f
#f
'(0 1 2 3 4 5 6 7 8)
#f
'full-module-binding))
(define full-module-binding45.1
(|#%name|
full-module-binding
(record-constructor
(make-record-constructor-descriptor struct:full-module-binding #f #f))))
(define full-module-binding?
(|#%name|
full-module-binding?
(record-predicate struct:full-module-binding)))
(define full-module-binding-module
(|#%name|
full-module-binding-module
(record-accessor struct:full-module-binding 0)))
(define full-module-binding-phase
(|#%name|
full-module-binding-phase
(record-accessor struct:full-module-binding 1)))
(define full-module-binding-sym
(|#%name|
full-module-binding-sym
(record-accessor struct:full-module-binding 2)))
(define full-module-binding-nominal-module
(|#%name|
full-module-binding-nominal-module
(record-accessor struct:full-module-binding 3)))
(define full-module-binding-nominal-phase
(|#%name|
full-module-binding-nominal-phase
(record-accessor struct:full-module-binding 4)))
(define full-module-binding-nominal-sym
(|#%name|
full-module-binding-nominal-sym
(record-accessor struct:full-module-binding 5)))
(define full-module-binding-nominal-require-phase
(|#%name|
full-module-binding-nominal-require-phase
(record-accessor struct:full-module-binding 6)))
(define full-module-binding-extra-inspector
(|#%name|
full-module-binding-extra-inspector
(record-accessor struct:full-module-binding 7)))
(define full-module-binding-extra-nominal-bindings
(|#%name|
full-module-binding-extra-nominal-bindings
(record-accessor struct:full-module-binding 8)))
(define struct:simple-module-binding
(make-record-type-descriptor*
'simple-module-binding
#f
(|#%nongenerative-uid| simple-module-binding)
#f
#f
4
0))
(define effect_2189
(struct-type-install-properties!
struct:simple-module-binding
'simple-module-binding
4
0
#f
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (b_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2755)
(|#%app| ser-push!_0 (simple-module-binding-module b_0))
(|#%app| ser-push!_0 (simple-module-binding-sym b_0))
(|#%app| ser-push!_0 (simple-module-binding-phase b_0))
(|#%app| ser-push!_0 (simple-module-binding-nominal-module b_0))))))
#f
#f
'(0 1 2 3)
#f
'simple-module-binding))
(define simple-module-binding46.1
(|#%name|
simple-module-binding
(record-constructor
(make-record-constructor-descriptor struct:simple-module-binding #f #f))))
(define simple-module-binding?
(|#%name|
simple-module-binding?
(record-predicate struct:simple-module-binding)))
(define simple-module-binding-module
(|#%name|
simple-module-binding-module
(record-accessor struct:simple-module-binding 0)))
(define simple-module-binding-phase
(|#%name|
simple-module-binding-phase
(record-accessor struct:simple-module-binding 1)))
(define simple-module-binding-sym
(|#%name|
simple-module-binding-sym
(record-accessor struct:simple-module-binding 2)))
(define simple-module-binding-nominal-module
(|#%name|
simple-module-binding-nominal-module
(record-accessor struct:simple-module-binding 3)))
(define deserialize-full-module-binding
(lambda (module_0
sym_0
phase_0
nominal-module_0
nominal-phase_0
nominal-sym_0
nominal-require-phase_0
free=id_0
extra-inspector_0
extra-nominal-bindings_0)
(make-module-binding.1
extra-inspector_0
extra-nominal-bindings_0
#f
free=id_0
nominal-module_0
nominal-phase_0
nominal-require-phase_0
nominal-sym_0
module_0
phase_0
sym_0)))
(define deserialize-simple-module-binding
(lambda (module_0 sym_0 phase_0 nominal-module_0)
(simple-module-binding46.1 module_0 phase_0 sym_0 nominal-module_0)))
(define module-binding-module
(lambda (b_0)
(if (simple-module-binding? b_0)
(simple-module-binding-module b_0)
(full-module-binding-module b_0))))
(define module-binding-phase
(lambda (b_0)
(if (simple-module-binding? b_0)
(simple-module-binding-phase b_0)
(full-module-binding-phase b_0))))
(define module-binding-sym
(lambda (b_0)
(if (simple-module-binding? b_0)
(simple-module-binding-sym b_0)
(full-module-binding-sym b_0))))
(define module-binding-nominal-module
(lambda (b_0)
(if (simple-module-binding? b_0)
(simple-module-binding-nominal-module b_0)
(full-module-binding-nominal-module b_0))))
(define module-binding-nominal-phase
(lambda (b_0)
(if (simple-module-binding? b_0)
(simple-module-binding-phase b_0)
(full-module-binding-nominal-phase b_0))))
(define module-binding-nominal-sym
(lambda (b_0)
(if (simple-module-binding? b_0)
(simple-module-binding-sym b_0)
(full-module-binding-nominal-sym b_0))))
(define module-binding-nominal-require-phase
(lambda (b_0)
(if (simple-module-binding? b_0)
0
(full-module-binding-nominal-require-phase b_0))))
(define module-binding-extra-inspector
(lambda (b_0)
(if (simple-module-binding? b_0)
#f
(full-module-binding-extra-inspector b_0))))
(define module-binding-extra-nominal-bindings
(lambda (b_0)
(if (simple-module-binding? b_0)
null
(full-module-binding-extra-nominal-bindings b_0))))
(define empty-binding-table hash2610)
(define struct:table-with-bulk-bindings
(make-record-type-descriptor*
'table-with-bulk-bindings
#f
(|#%nongenerative-uid| table-with-bulk-bindings)
#f
#f
3
0))
(define effect_2548
(struct-type-install-properties!
struct:table-with-bulk-bindings
'table-with-bulk-bindings
3
0
#f
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (twbb_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2169)
(|#%app| ser-push!_0 (table-with-bulk-bindings-syms/serialize twbb_0))
(|#%app|
ser-push!_0
(table-with-bulk-bindings-bulk-bindings twbb_0))))))
(current-inspector)
#f
'(0 1 2)
#f
'table-with-bulk-bindings))
(define table-with-bulk-bindings1.1
(|#%name|
table-with-bulk-bindings
(record-constructor
(make-record-constructor-descriptor
struct:table-with-bulk-bindings
#f
#f))))
(define table-with-bulk-bindings?
(|#%name|
table-with-bulk-bindings?
(record-predicate struct:table-with-bulk-bindings)))
(define table-with-bulk-bindings-syms
(|#%name|
table-with-bulk-bindings-syms
(record-accessor struct:table-with-bulk-bindings 0)))
(define table-with-bulk-bindings-syms/serialize
(|#%name|
table-with-bulk-bindings-syms/serialize
(record-accessor struct:table-with-bulk-bindings 1)))
(define table-with-bulk-bindings-bulk-bindings
(|#%name|
table-with-bulk-bindings-bulk-bindings
(record-accessor struct:table-with-bulk-bindings 2)))
(define deserialize-table-with-bulk-bindings
(lambda (syms_0 bulk-bindings_0)
(table-with-bulk-bindings1.1 syms_0 syms_0 bulk-bindings_0)))
(define struct:bulk-binding-at
(make-record-type-descriptor*
'bulk-binding-at
#f
(|#%nongenerative-uid| bulk-binding-at)
#f
#f
2
0))
(define effect_2443
(struct-type-install-properties!
struct:bulk-binding-at
'bulk-binding-at
2
0
#f
(list
(cons prop:authentic #t)
(cons
prop:reach-scopes
(lambda (sms_0 reach_0) (error "shouldn't get here")))
(cons
prop:serialize
(lambda (bba_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2707)
(|#%app| ser-push!_0 (bulk-binding-at-scopes bba_0))
(|#%app| ser-push!_0 (bulk-binding-at-bulk bba_0))))))
(current-inspector)
#f
'(0 1)
#f
'bulk-binding-at))
(define bulk-binding-at2.1
(|#%name|
bulk-binding-at
(record-constructor
(make-record-constructor-descriptor struct:bulk-binding-at #f #f))))
(define bulk-binding-at?
(|#%name| bulk-binding-at? (record-predicate struct:bulk-binding-at)))
(define bulk-binding-at-scopes
(|#%name| bulk-binding-at-scopes (record-accessor struct:bulk-binding-at 0)))
(define bulk-binding-at-bulk
(|#%name| bulk-binding-at-bulk (record-accessor struct:bulk-binding-at 1)))
(define deserialize-bulk-binding-at
(lambda (scopes_0 bulk_0) (bulk-binding-at2.1 scopes_0 bulk_0)))
(define-values
(prop:bulk-binding bulk-binding?$1 bulk-binding-ref)
(make-struct-type-property 'bulk-binding))
(define struct:bulk-binding-class
(make-record-type-descriptor*
'bulk-binding-class
#f
(|#%nongenerative-uid| bulk-binding-class)
#f
#f
2
0))
(define effect_2256
(struct-type-install-properties!
struct:bulk-binding-class
'bulk-binding-class
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'bulk-binding-class))
(define bulk-binding-class3.1
(|#%name|
bulk-binding-class
(record-constructor
(make-record-constructor-descriptor struct:bulk-binding-class #f #f))))
(define bulk-binding-class?_2308
(|#%name| bulk-binding-class? (record-predicate struct:bulk-binding-class)))
(define bulk-binding-class?
(|#%name|
bulk-binding-class?
(lambda (v)
(if (bulk-binding-class?_2308 v)
#t
($value
(if (impersonator? v)
(bulk-binding-class?_2308 (impersonator-val v))
#f))))))
(define bulk-binding-class-get-symbols_2451
(|#%name|
bulk-binding-class-get-symbols
(record-accessor struct:bulk-binding-class 0)))
(define bulk-binding-class-get-symbols
(|#%name|
bulk-binding-class-get-symbols
(lambda (s)
(if (bulk-binding-class?_2308 s)
(bulk-binding-class-get-symbols_2451 s)
($value
(impersonate-ref
bulk-binding-class-get-symbols_2451
struct:bulk-binding-class
0
s
'bulk-binding-class
'get-symbols))))))
(define bulk-binding-class-create_3361
(|#%name|
bulk-binding-class-create
(record-accessor struct:bulk-binding-class 1)))
(define bulk-binding-class-create
(|#%name|
bulk-binding-class-create
(lambda (s)
(if (bulk-binding-class?_2308 s)
(bulk-binding-class-create_3361 s)
($value
(impersonate-ref
bulk-binding-class-create_3361
struct:bulk-binding-class
1
s
'bulk-binding-class
'create))))))
(define bulk-binding-symbols
(lambda (b_0 s_0 extra-shifts_0)
(let ((app_0 (bulk-binding-class-get-symbols (bulk-binding-ref b_0))))
(|#%app|
app_0
b_0
(append extra-shifts_0 (if s_0 (syntax-mpi-shifts s_0) null))))))
(define bulk-binding-create
(lambda (b_0) (bulk-binding-class-create (bulk-binding-ref b_0))))
(define binding-table-empty?
(lambda (bt_0) (if (hash? bt_0) (zero? (hash-count bt_0)) #f)))
(define binding-table-add
(lambda (bt_0 scopes_0 sym_0 binding_0 just-for-nominal?_0)
(if (hash? bt_0)
(hash-set
bt_0
sym_0
(hash-set (hash-ref bt_0 sym_0 hash2725) scopes_0 binding_0))
(let ((new-syms_0
(binding-table-add
(table-with-bulk-bindings-syms bt_0)
scopes_0
sym_0
binding_0
just-for-nominal?_0)))
(let ((new-syms/serialize_0
(if just-for-nominal?_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)
scopes_0
sym_0
binding_0
#f)))))
(if (table-with-bulk-bindings? bt_0)
(table-with-bulk-bindings1.1
new-syms_0
new-syms/serialize_0
(table-with-bulk-bindings-bulk-bindings bt_0))
(raise-argument-error
'struct-copy
"table-with-bulk-bindings?"
bt_0)))))))
(define-values
(prop:implicitly-reachable implicitly-reachable? implicitly-reachable-ref)
(make-struct-type-property 'implicitly-reachable))
(define binding-table-add-bulk.1
(|#%name|
binding-table-add-bulk
(lambda (shadow-except4_0 bt6_0 scopes7_0 bulk8_0)
(begin
(if (table-with-bulk-bindings? 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 (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
(|#%name|
remove-matching-bindings
(lambda (except10_0 syms12_0 scopes13_0 bulk14_0)
(begin
(let ((bulk-symbols_0 (bulk-binding-symbols bulk14_0 #f null)))
(if (let ((app_0 (hash-count syms12_0)))
(< app_0 (hash-count bulk-symbols_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (syms_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
syms12_0
i_0))
(case-lambda
((sym_0 sym-bindings_0)
(let ((syms_1
(let ((syms_1
(if (hash-ref bulk-symbols_0 sym_0 #f)
(remove-matching-binding.1
except10_0
syms_0
sym_0
sym-bindings_0
scopes13_0)
syms_0)))
(values syms_1))))
(for-loop_0
syms_1
(unsafe-immutable-hash-iterate-next
syms12_0
i_0))))
(args (raise-binding-result-arity-error 2 args))))
syms_0))))))
(for-loop_0
syms12_0
(unsafe-immutable-hash-iterate-first syms12_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (syms_0 i_0)
(begin
(if i_0
(let ((sym_0
(unsafe-immutable-hash-iterate-key
bulk-symbols_0
i_0)))
(let ((syms_1
(let ((syms_1
(let ((sym-bindings_0
(hash-ref syms_0 sym_0 #f)))
(if sym-bindings_0
(remove-matching-binding.1
except10_0
syms_0
sym_0
sym-bindings_0
scopes13_0)
syms_0))))
(values syms_1))))
(for-loop_0
syms_1
(unsafe-immutable-hash-iterate-next
bulk-symbols_0
i_0))))
syms_0))))))
(for-loop_0
syms12_0
(unsafe-immutable-hash-iterate-first bulk-symbols_0))))))))))
(define remove-matching-binding.1
(|#%name|
remove-matching-binding
(lambda (except16_0 syms18_0 sym19_0 sym-bindings20_0 scopes21_0)
(begin
(if (if except16_0
(let ((b_0 (hash-ref sym-bindings20_0 scopes21_0 #f)))
(if (module-binding? b_0)
(eq? except16_0 (module-binding-module b_0))
#f))
#f)
syms18_0
(hash-set
syms18_0
sym19_0
(hash-remove sym-bindings20_0 scopes21_0)))))))
(define next-state-in-full-binding-table
(lambda (sym-ht_0 sym-i_0)
(if sym-i_0
(let ((ht_0 (hash-iterate-value sym-ht_0 sym-i_0)))
(let ((i_0 (hash-iterate-first ht_0)))
(if i_0
(cons
(vector sym-i_0 (hash-iterate-key sym-ht_0 sym-i_0) ht_0)
i_0)
(next-state-in-full-binding-table
sym-ht_0
(hash-iterate-next sym-ht_0 sym-i_0)))))
'(#f . #f))))
(define binding-table-symbols
(lambda (table_0 scs_0 s_0 extra-shifts_0)
(call-with-values
(lambda ()
(if (hash? table_0)
(values table_0 null)
(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
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_1 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((sym_0 at-sym_0)
(let ((table_2
(if (begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (result_0 i_1)
(begin
(if i_1
(let ((an-scs_0
(hash-iterate-key
at-sym_0
i_1)))
(let ((result_1
(let ((result_1
(begin-unsafe
(hash-keys-subset?
an-scs_0
scs_0))))
(values
result_1))))
(if (if (not
(let ((x_0
(list
an-scs_0)))
result_1))
#t
#f)
(for-loop_1
result_1
(hash-iterate-next
at-sym_0
i_1))
result_1)))
result_0))))))
(for-loop_1
#f
(hash-iterate-first at-sym_0))))
(let ((table_2
(call-with-values
(lambda () (values sym_0 #t))
(case-lambda
((key_0 val_0)
(hash-set table_1 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_2))
table_1)))
(for-loop_0
table_2
(hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_1))))))
(for-loop_0 hash2610 (hash-iterate-first ht_0))))))
(set-union
app_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_1 lst_0)
(begin
(if (pair? lst_0)
(let ((bba_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_2
(if (let ((s1_0
(bulk-binding-at-scopes bba_0)))
(begin-unsafe
(hash-keys-subset? s1_0 scs_0)))
(let ((ht_1
(bulk-binding-symbols
(bulk-binding-at-bulk bba_0)
s_0
extra-shifts_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_2 i_0)
(begin
(if i_0
(let ((sym_0
(hash-iterate-key
ht_1
i_0)))
(let ((table_3
(let ((table_3
(call-with-values
(lambda ()
(values
sym_0
#t))
(case-lambda
((key_0
val_0)
(hash-set
table_2
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_3))))
(for-loop_1
table_3
(hash-iterate-next
ht_1
i_0))))
table_2))))))
(for-loop_1
table_1
(hash-iterate-first ht_1)))))
table_1)))
(for-loop_0 table_2 rest_0))))
table_1))))))
(for-loop_0 hash2610 bulk-bindings_0))))))
(args (raise-binding-result-arity-error 2 args))))))
(define binding-table-prune-to-reachable
(lambda (bt_0 state_0)
(let ((or-part_0
(hash-ref (serialize-state-bindings-intern state_0) bt_0 #f)))
(if or-part_0
or-part_0
(let ((reachable-scopes_0 (serialize-state-reachable-scopes state_0)))
(let ((new-syms_0
(let ((ht_0
(if (hash? bt_0)
bt_0
(table-with-bulk-bindings-syms/serialize bt_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
ht_0
i_0))
(case-lambda
((sym_0 bindings-for-sym_0)
(let ((table_1
(let ((new-bindings-for-sym_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1 i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
bindings-for-sym_0
i_1))
(case-lambda
((scopes_0
binding_0)
(let ((table_2
(if (begin-unsafe
(hash-keys-subset?
scopes_0
reachable-scopes_0))
(let ((table_2
(call-with-values
(lambda ()
(values
(intern-scopes
scopes_0
state_0)
binding_0))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))
table_1)))
(for-loop_1
table_2
(unsafe-immutable-hash-iterate-next
bindings-for-sym_0
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
table_1))))))
(for-loop_1
hash2725
(unsafe-immutable-hash-iterate-first
bindings-for-sym_0))))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(if (positive?
(hash-count
new-bindings-for-sym_0))
(let ((table_2
(call-with-values
(lambda ()
(values
sym_0
new-bindings-for-sym_0))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))
table_1)))
table_2))))))
(for-loop_1 table_0))))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next
ht_0
i_0))))
(args
(raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0
hash2610
(unsafe-immutable-hash-iterate-first ht_0)))))))
(let ((new-bulk-bindings_0
(if (hash? bt_0)
null
(reverse$1
(let ((lst_0
(table-with-bulk-bindings-bulk-bindings bt_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((bba_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(if (let ((s1_0
(bulk-binding-at-scopes
bba_0)))
(begin-unsafe
(hash-keys-subset?
s1_0
reachable-scopes_0)))
(let ((fold-var_1
(cons
(if (bulk-binding-at?
bba_0)
(let ((scopes49_0
(intern-scopes
(bulk-binding-at-scopes
bba_0)
state_0)))
(bulk-binding-at2.1
scopes49_0
(bulk-binding-at-bulk
bba_0)))
(raise-argument-error
'struct-copy
"bulk-binding-at?"
bba_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 lst_0))))))))
(let ((new-bt_0
(if (pair? new-bulk-bindings_0)
(table-with-bulk-bindings1.1
new-syms_0
new-syms_0
new-bulk-bindings_0)
new-syms_0)))
(begin
(hash-set!
(serialize-state-bulk-bindings-intern state_0)
bt_0
new-bt_0)
new-bt_0)))))))))
(define binding-table-register-reachable
(lambda (bt_0 get-reachable-scopes_0 reach_0 register-trigger_0)
(begin
(let ((ht_0
(if (hash? bt_0)
bt_0
(table-with-bulk-bindings-syms/serialize bt_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value ht_0 i_0))
(case-lambda
((sym_0 bindings-for-sym_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
bindings-for-sym_0
i_1))
(case-lambda
((scopes_0 binding_0)
(begin
(let ((v_0
(if (binding-reach-scopes?
binding_0)
(|#%app|
(binding-reach-scopes-ref
binding_0)
binding_0)
#f)))
(scopes-register-reachable
scopes_0
v_0
get-reachable-scopes_0
reach_0
register-trigger_0))
(for-loop_1
(unsafe-immutable-hash-iterate-next
bindings-for-sym_0
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_1
(unsafe-immutable-hash-iterate-first
bindings-for-sym_0)))))
(case-lambda
(()
(for-loop_0
(unsafe-immutable-hash-iterate-next ht_0 i_0)))
(args (raise-binding-result-arity-error 0 args)))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (unsafe-immutable-hash-iterate-first ht_0)))))
(void)
(if (table-with-bulk-bindings? bt_0)
(begin
(let ((lst_0 (table-with-bulk-bindings-bulk-bindings bt_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((bba_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(scopes-register-reachable
(bulk-binding-at-scopes bba_0)
#f
get-reachable-scopes_0
reach_0
register-trigger_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void))
(void)))))
(define scopes-register-reachable
(lambda (scopes_0 v_0 get-reachable-scopes_0 reach_0 register-trigger_0)
(let ((reachable-scopes_0 (|#%app| get-reachable-scopes_0)))
(if (begin-unsafe (hash-keys-subset? scopes_0 reachable-scopes_0))
(|#%app| reach_0 v_0)
(let ((pending-scopes_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
scopes_0
i_0)))
(let ((table_1
(if (let ((or-part_0
(begin-unsafe
(hash-ref
reachable-scopes_0
sc_0
#f))))
(if or-part_0
or-part_0
(implicitly-reachable? sc_0)))
table_0
(let ((table_1
(call-with-values
(lambda () (values sc_0 #t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1)))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next
scopes_0
i_0))))
table_0))))))
(for-loop_0
hash2610
(unsafe-immutable-hash-iterate-first scopes_0))))))
(let ((check-trigger_0
(|#%name|
check-trigger
(lambda (reach_1)
(begin
(if (zero? (hash-count pending-scopes_0))
(begin
(|#%app| reach_1 v_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
scopes_0
i_0)))
(begin
(if (implicitly-reachable? sc_0)
(|#%app| reach_1 sc_0)
(void))
(for-loop_0
(unsafe-immutable-hash-iterate-next
scopes_0
i_0))))
(values)))))))
(for-loop_0
(unsafe-immutable-hash-iterate-first scopes_0))))
(void))
(void)))))))
(begin
(let ((ht_0 pending-scopes_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
ht_0
i_0)))
(begin
(|#%app|
register-trigger_0
sc_0
(lambda (reach_1)
(begin
(set! pending-scopes_0
(hash-remove pending-scopes_0 sc_0))
(check-trigger_0 reach_1))))
(for-loop_0
(unsafe-immutable-hash-iterate-next
ht_0
i_0))))
(values)))))))
(for-loop_0 (unsafe-immutable-hash-iterate-first ht_0)))))
(void)
(check-trigger_0 reach_0))))))))
(define syntax-property$1
(|#%name|
syntax-property
(case-lambda
((s_0 key_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-property "syntax?" s_0))
(let ((v_0 (hash-ref (syntax-props s_0) key_0 #f)))
(plain-property-value v_0)))))
((s_0 key_0 val_0)
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-property "syntax?" s_0))
(let ((pval_0
(if (eq? key_0 'paren-shape)
(preserved-property-value1.1 val_0)
val_0)))
(if (syntax?$1 s_0)
(let ((props2_0 (hash-set (syntax-props s_0) key_0 pval_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
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-property "syntax?" s_0))
(begin
(if preserved?_0
(if (if (symbol? key_0) (symbol-interned? key_0) #f)
(void)
(raise-arguments-error
'syntax-property
"key for a preserved property must be an interned symbol"
"given key"
key_0
"given value"
val_0))
(void))
(let ((pval_0
(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)))
(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|
syntax-property-preserved?
(lambda (s_0 key_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-property-preserved? "syntax?" s_0))
(if (if (symbol? key_0) (symbol-interned? key_0) #f)
(void)
(raise-argument-error
'syntax-property-preserved?
"(and/c symbol? symbol-interned?)"
key_0))
(preserved-property-value?
(hash-ref (syntax-props s_0) key_0 #f)))))))
(define 1/syntax-property-symbol-keys
(|#%name|
syntax-property-symbol-keys
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-property-symbol-keys "syntax" s_0))
(reverse$1
(let ((ht_0 (syntax-props s_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((fold-var_1
(if (if (symbol? k_0)
(symbol-interned? k_0)
#f)
(let ((fold-var_1 (cons k_0 fold-var_0)))
(values fold-var_1))
fold-var_0)))
(for-loop_0
fold-var_1
(unsafe-immutable-hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
fold-var_0))))))
(for-loop_0
null
(unsafe-immutable-hash-iterate-first ht_0)))))))))))
(define 1/syntax-property-remove
(|#%name|
syntax-property-remove
(lambda (s_0 key_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-property-remove "syntax?" s_0))
(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)))
(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?
(lambda (from-s_0 key_0) (hash-ref (syntax-props from-s_0) key_0 #f)))
(define taint-content
(lambda (d_0)
(let ((f_0 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))))
(let ((s->_0
(|#%name|
s->
(lambda (sub-s_0)
(begin
(if (let ((v_0 (syntax-tamper sub-s_0)))
(begin-unsafe (symbol? v_0)))
sub-s_0
(let ((t_0
(tamper-tainted-for-content
(syntax-content sub-s_0))))
(let ((content*_0 (syntax-content* sub-s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 sub-s_0)
(let ((content*3_0
(let ((new-p_0
(if (tamper? p_0)
t_0
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
t_0))))
(if new-p_0
(modified-content1.1
content_0
new-p_0)
content_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?"
sub-s_0))))))))))))
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(s->_0 v_0)
(begin-unsafe (begin v_0))))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 s_0 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (null? s_0)
(begin-unsafe (begin s_0))
(if (pair? s_0)
(let ((x_0
(let ((app_0 (loop_0 #f (car s_0) depth_0)))
(cons app_0 (loop_0 1 (cdr s_0) depth_0)))))
(begin-unsafe (begin x_0)))
(if (symbol? s_0)
(begin-unsafe (begin s_0))
(if (boolean? s_0)
(begin-unsafe (begin s_0))
(if (number? s_0)
(begin-unsafe (begin s_0))
(if (let ((or-part_0 (vector? s_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (box? s_0)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key s_0)))
(if or-part_2
or-part_2
(hash? s_0)))))))
(datum-map-slow
tail?_0
s_0
(lambda (tail?_1 s_1) (gf_0 tail?_1 s_1))
#f
#f)
(gf_0 #f s_0)))))))))))))
(loop_0 #f d_0 0))))))))
(define syntax-tainted?$1
(|#%name|
syntax-tainted?
(lambda (s_0)
(begin (let ((v_0 (syntax-tamper s_0))) (begin-unsafe (symbol? v_0)))))))
(define syntax-clean?
(lambda (s_0) (let ((v_0 (syntax-tamper s_0))) (begin-unsafe (not v_0)))))
(define syntax-arm$1
(|#%name|
syntax-arm
(lambda (s_0 insp_0)
(begin
(let ((t_0 (syntax-tamper s_0)))
(if (begin-unsafe (symbol? t_0))
s_0
(if (if t_0
(let ((or-part_0 (begin-unsafe (hash-ref t_0 insp_0 #f))))
(if or-part_0
or-part_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 i_0)
(begin
(if i_0
(let ((already-insp_0
(unsafe-immutable-hash-iterate-key
t_0
i_0)))
(let ((result_1
(let ((result_1
(inspector-superior-or-same?
already-insp_0
insp_0)))
(values result_1))))
(if (if (not
(let ((x_0
(list already-insp_0)))
result_1))
#t
#f)
(for-loop_0
result_1
(unsafe-immutable-hash-iterate-next
t_0
i_0))
result_1)))
result_0))))))
(for-loop_0
#f
(unsafe-immutable-hash-iterate-first t_0))))))
#f)
s_0
(let ((t_1
(let ((s_1 (if t_0 (remove-inferior t_0 insp_0) (seteq))))
(begin-unsafe (hash-set s_1 insp_0 #t)))))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 s_0)
(let ((content*4_0
(let ((new-p_0
(if (tamper? p_0)
t_1
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
t_1))))
(if new-p_0
(modified-content1.1 content_0 new-p_0)
content_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?"
s_0)))))))))))))
(define remove-inferior
(lambda (t_0 insp_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((already-insp_0
(unsafe-immutable-hash-iterate-key t_0 i_0)))
(let ((table_1
(if (inspector-superior-or-same?
insp_0
already-insp_0)
table_0
(let ((table_1
(call-with-values
(lambda () (values already-insp_0 #t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1)))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next t_0 i_0))))
table_0))))))
(for-loop_0 hash2610 (unsafe-immutable-hash-iterate-first t_0))))))
(define syntax-disarm$1
(let ((syntax-disarm_0
(|#%name|
syntax-disarm
(lambda (s2_0 insp1_0)
(begin
(let ((t_0 (syntax-tamper s2_0)))
(if (not (begin-unsafe (begin-unsafe (hash? t_0))))
s2_0
(if (not insp1_0)
(let ((content*_0 (syntax-content* s2_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 s2_0)
(let ((content*5_0
(let ((new-p_0
(if (tamper? p_0)
#f
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
#f))))
(if new-p_0
(modified-content1.1 content_0 new-p_0)
content_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?"
s2_0)))))
(let ((new-t_0 (remove-inferior t_0 insp1_0)))
(let ((t_1
(if (not
(begin-unsafe (zero? (hash-count new-t_0))))
new-t_0
#f)))
(let ((content*_0 (syntax-content* s2_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 s2_0)
(let ((content*6_0
(let ((new-p_0
(if (tamper? p_0)
t_1
(|#%app|
(propagation-set-tamper-ref
p_0)
p_0
t_1))))
(if new-p_0
(modified-content1.1
content_0
new-p_0)
content_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?"
s2_0)))))))))))))))
(|#%name|
syntax-disarm
(case-lambda
((s_0) (begin (syntax-disarm_0 s_0 #f)))
((s_0 insp1_0) (syntax-disarm_0 s_0 insp1_0))))))
(define syntax-rearm$1
(|#%name|
syntax-rearm
(lambda (s_0 from-s_0)
(begin
(let ((t_0 (syntax-tamper s_0)))
(if (begin-unsafe (symbol? t_0))
s_0
(let ((from-t_0 (syntax-tamper from-s_0)))
(if (begin-unsafe (not from-t_0))
s_0
(if (begin-unsafe (symbol? from-t_0))
(let ((t_1 (tamper-tainted-for-content (syntax-content s_0))))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 s_0)
(let ((content*7_0
(let ((new-p_0
(if (tamper? p_0)
t_1
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
t_1))))
(if new-p_0
(modified-content1.1 content_0 new-p_0)
content_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?"
s_0))))))
(if (begin-unsafe (not t_0))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 s_0)
(let ((content*8_0
(let ((new-p_0
(if (tamper? p_0)
from-t_0
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
from-t_0))))
(if new-p_0
(modified-content1.1 content_0 new-p_0)
content_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?"
s_0)))))
(let ((t_1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (t_1 i_0)
(begin
(if i_0
(let ((from-i_0
(unsafe-immutable-hash-iterate-key
from-t_0
i_0)))
(let ((t_2
(let ((t_2
(if (begin-unsafe
(hash-ref
t_1
from-i_0
#f))
t_1
(if (any-superior?
t_1
from-i_0)
t_1
(let ((s_1
(remove-inferior
t_1
from-i_0)))
(begin-unsafe
(hash-set
s_1
from-i_0
#t)))))))
(values t_2))))
(for-loop_0
t_2
(unsafe-immutable-hash-iterate-next
from-t_0
i_0))))
t_1))))))
(for-loop_0
t_0
(unsafe-immutable-hash-iterate-first
from-t_0))))))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)))
(if (syntax?$1 s_0)
(let ((content*9_0
(let ((new-p_0
(if (tamper? p_0)
t_1
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
t_1))))
(if new-p_0
(modified-content1.1 content_0 new-p_0)
content_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?"
s_0))))))))))))))))
(define syntax-taint$1
(|#%name|
syntax-taint
(lambda (s_0)
(begin
(if (let ((v_0 (syntax-tamper s_0))) (begin-unsafe (symbol? v_0)))
s_0
(let ((t_0 (tamper-tainted-for-content (syntax-content s_0))))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(let ((p_0
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper content*_0)
#f)))
(if (syntax?$1 s_0)
(let ((content*10_0
(let ((new-p_0
(if (tamper? p_0)
t_0
(|#%app|
(propagation-set-tamper-ref p_0)
p_0
t_0))))
(if new-p_0
(modified-content1.1 content_0 new-p_0)
content_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)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 i_0)
(begin
(if i_0
(let ((i_1 (unsafe-immutable-hash-iterate-key t_0 i_0)))
(let ((result_1
(let ((result_1
(inspector-superior-or-same? i_1 from-i_0)))
(values result_1))))
(if (if (not (let ((x_0 (list i_1))) result_1)) #t #f)
(for-loop_0
result_1
(unsafe-immutable-hash-iterate-next t_0 i_0))
result_1)))
result_0))))))
(for-loop_0 #f (unsafe-immutable-hash-iterate-first t_0))))))
(define inspector-superior-or-same?
(lambda (sup-i_0 i_0)
(let ((or-part_0 (eq? sup-i_0 i_0)))
(if or-part_0 or-part_0 (inspector-superior? sup-i_0 i_0)))))
(define struct:fallback
(make-record-type-descriptor*
'fallback
#f
(structure-type-lookup-prefab-uid 'fallback #f 1 0 #f '(0))
#f
#f
1
1))
(define effect_2018
(struct-type-install-properties!
struct:fallback
'fallback
1
0
#f
null
'prefab
#f
'(0)
#f
'fallback))
(define fallback1.1
(|#%name|
fallback
(record-constructor
(make-record-constructor-descriptor struct:fallback #f #f))))
(define fallback?_2815 (|#%name| fallback? (record-predicate struct:fallback)))
(define fallback?
(|#%name|
fallback?
(lambda (v)
(if (fallback?_2815 v)
#t
($value
(if (impersonator? v) (fallback?_2815 (impersonator-val v)) #f))))))
(define fallback-search-list_2731
(|#%name| fallback-search-list (record-accessor struct:fallback 0)))
(define fallback-search-list
(|#%name|
fallback-search-list
(lambda (s)
(if (fallback?_2815 s)
(fallback-search-list_2731 s)
($value
(impersonate-ref
fallback-search-list_2731
struct:fallback
0
s
'fallback
'search-list))))))
(define fallback-first
(lambda (smss_0)
(if (fallback? smss_0) (car (fallback-search-list smss_0)) smss_0)))
(define fallback-rest
(lambda (smss_0)
(let ((l_0 (cdr (fallback-search-list smss_0))))
(if (null? (cdr l_0)) (car l_0) (fallback1.1 l_0)))))
(define fallback-push
(lambda (smss_0 smss/maybe-fallback_0)
(fallback1.1
(cons
smss_0
(if (fallback? smss/maybe-fallback_0)
(fallback-search-list smss/maybe-fallback_0)
(list smss/maybe-fallback_0))))))
(define fallback-update-first
(lambda (smss_0 f_0)
(if (fallback? smss_0)
(let ((l_0 (fallback-search-list smss_0)))
(fallback1.1
(let ((app_0 (|#%app| f_0 (car l_0)))) (cons app_0 (cdr l_0)))))
(|#%app| f_0 smss_0))))
(define fallback-map
(lambda (smss_0 f_0)
(if (fallback? smss_0)
(fallback1.1
(reverse$1
(let ((lst_0 (fallback-search-list smss_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((smss_1 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(|#%app| f_0 smss_1)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0))))))
(|#%app| f_0 smss_0))))
(define fallback->list
(lambda (smss_0)
(if (fallback? smss_0) (fallback-search-list smss_0) (list smss_0))))
(define make-cache$1
(|#%name| make-cache (lambda () (begin (box (make-weak-box #f))))))
(define cell.1$6 (unsafe-make-place-local (make-cache$1)))
(define resolve-cache-place-init!
(lambda () (unsafe-place-local-set! cell.1$6 (make-cache$1))))
(define clear-resolve-cache!
(case-lambda
((sym_0)
(let ((c_0
(weak-box-value (unsafe-unbox* (unsafe-place-local-ref cell.1$6)))))
(begin
(if c_0 (hash-remove! c_0 sym_0) (void))
(unsafe-set-box*! (unsafe-place-local-ref cell.2$3) #f))))
(()
(let ((c_0
(weak-box-value (unsafe-unbox* (unsafe-place-local-ref cell.1$6)))))
(begin
(if c_0 (hash-clear! c_0) (void))
(unsafe-set-box*! (unsafe-place-local-ref cell.2$3) #f))))))
(define struct:entry
(make-record-type-descriptor*
'entry
#f
(|#%nongenerative-uid| entry)
#f
#f
4
0))
(define effect_2205
(struct-type-install-properties!
struct:entry
'entry
4
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3)
#f
'entry))
(define entry1.1
(|#%name|
entry
(record-constructor
(make-record-constructor-descriptor struct:entry #f #f))))
(define entry? (|#%name| entry? (record-predicate struct:entry)))
(define entry-scs (|#%name| entry-scs (record-accessor struct:entry 0)))
(define entry-smss (|#%name| entry-smss (record-accessor struct:entry 1)))
(define entry-phase (|#%name| entry-phase (record-accessor struct:entry 2)))
(define entry-binding
(|#%name| entry-binding (record-accessor struct:entry 3)))
(define resolve-cache-get
(lambda (sym_0 phase_0 scs_0 smss_0)
(let ((c_0
(weak-box-value (unsafe-unbox* (unsafe-place-local-ref cell.1$6)))))
(if c_0
(let ((v_0 (hash-ref c_0 sym_0 #f)))
(if v_0
(if (eqv? phase_0 (entry-phase v_0))
(if (set=? scs_0 (entry-scs v_0))
(if (set=? smss_0 (entry-smss v_0)) (entry-binding v_0) #f)
#f)
#f)
#f))
#f))))
(define resolve-cache-set!
(lambda (sym_0 phase_0 scs_0 smss_0 b_0)
(let ((wb_0 (unsafe-unbox* (unsafe-place-local-ref cell.1$6))))
(let ((c_0 (weak-box-value wb_0)))
(if (not c_0)
(begin
(unsafe-box*-cas!
(unsafe-place-local-ref cell.1$6)
wb_0
(make-weak-box (make-hasheq)))
(resolve-cache-set! sym_0 phase_0 scs_0 smss_0 b_0))
(hash-set! c_0 sym_0 (entry1.1 scs_0 smss_0 phase_0 b_0)))))))
(define SHIFTED-CACHE-SIZE 16)
(define cell.2$3 (unsafe-make-place-local (box #f)))
(define cell.3$1 (unsafe-make-place-local 0))
(define struct:shifted-entry
(make-record-type-descriptor*
'shifted-entry
#f
(|#%nongenerative-uid| shifted-entry)
#f
#f
3
0))
(define effect_2339
(struct-type-install-properties!
struct:shifted-entry
'shifted-entry
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'shifted-entry))
(define shifted-entry2.1
(|#%name|
shifted-entry
(record-constructor
(make-record-constructor-descriptor struct:shifted-entry #f #f))))
(define shifted-entry?
(|#%name| shifted-entry? (record-predicate struct:shifted-entry)))
(define shifted-entry-s
(|#%name| shifted-entry-s (record-accessor struct:shifted-entry 0)))
(define shifted-entry-phase
(|#%name| shifted-entry-phase (record-accessor struct:shifted-entry 1)))
(define shifted-entry-binding
(|#%name| shifted-entry-binding (record-accessor struct:shifted-entry 2)))
(define shifted-cache-vector
(lambda ()
(let ((wb_0 (unsafe-unbox* (unsafe-place-local-ref cell.2$3))))
(let ((c1_0 (if wb_0 (weak-box-value wb_0) #f)))
(if c1_0
c1_0
(let ((vec_0 (make-vector 16 #f)))
(begin
(unsafe-set-box*!
(unsafe-place-local-ref cell.2$3)
(make-weak-box vec_0))
vec_0)))))))
(define resolve+shift-cache-get
(lambda (s_0 phase_0)
(let ((vec_0 (shifted-cache-vector)))
(call-with-values
(lambda ()
(begin
(check-vector vec_0)
(values vec_0 (unsafe-vector-length vec_0))))
(case-lambda
((vec_1 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((e_0 (unsafe-vector-ref vec_1 pos_0)))
(let ((result_1
(let ((result_1
(if e_0
(if (eq? s_0 (shifted-entry-s e_0))
(if (eqv?
phase_0
(shifted-entry-phase e_0))
(shifted-entry-binding e_0)
#f)
#f)
#f)))
(values result_1))))
(if (if (not (let ((x_0 (list e_0))) result_1)) #t #f)
(for-loop_0 result_1 (unsafe-fx+ 1 pos_0))
result_1)))
result_0))))))
(for-loop_0 #f 0))))
(args (raise-binding-result-arity-error 2 args)))))))
(define resolve+shift-cache-set!
(lambda (s_0 phase_0 b_0)
(let ((vec_0 (shifted-cache-vector)))
(let ((p_0 (unsafe-place-local-ref cell.3$1)))
(begin
(unsafe-vector*-set! vec_0 p_0 (shifted-entry2.1 s_0 phase_0 b_0))
(unsafe-place-local-set! cell.3$1 (fxand (fx+ 1 p_0) 15)))))))
(define NUM-CACHE-SLOTS 8)
(define make-cached-sets (lambda () (make-weak-box (make-vector 8 #f))))
(define cell.4$1 (unsafe-make-place-local (make-cached-sets)))
(define cell.5$1 (unsafe-make-place-local 0))
(define make-cached-hashes (lambda () (make-weak-box (make-vector 8 #f))))
(define cell.6$1 (unsafe-make-place-local (make-cached-hashes)))
(define cell.7 (unsafe-make-place-local 0))
(define sets-place-init!
(lambda ()
(begin
(unsafe-place-local-set! cell.4$1 (make-cached-sets))
(unsafe-place-local-set! cell.6$1 (make-cached-hashes)))))
(define cache-or-reuse-set
(lambda (s_0)
(let ((vec_0
(let ((or-part_0
(weak-box-value (unsafe-place-local-ref cell.4$1))))
(if or-part_0
or-part_0
(let ((vec_0 (make-vector 8 #f)))
(begin
(unsafe-place-local-set! cell.4$1 (make-weak-box vec_0))
vec_0))))))
(let ((or-part_0
(call-with-values
(lambda ()
(begin
(check-vector vec_0)
(values vec_0 (unsafe-vector-length vec_0))))
(case-lambda
((vec_1 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((s2_0 (unsafe-vector-ref vec_1 pos_0)))
(let ((result_1
(let ((result_1
(if s2_0
(if (set=? s_0 s2_0) s2_0 #f)
#f)))
(values result_1))))
(if (if (not
(let ((x_0 (list s2_0))) result_1))
#t
#f)
(for-loop_0 result_1 (unsafe-fx+ 1 pos_0))
result_1)))
result_0))))))
(for-loop_0 #f 0))))
(args (raise-binding-result-arity-error 2 args))))))
(if or-part_0
or-part_0
(begin
(unsafe-vector*-set! vec_0 (unsafe-place-local-ref cell.5$1) s_0)
(unsafe-place-local-set!
cell.5$1
(fxand (fx+ 1 (unsafe-place-local-ref cell.5$1)) 7))
s_0))))))
(define cache-or-reuse-hash
(lambda (s_0)
(let ((vec_0
(let ((or-part_0
(weak-box-value (unsafe-place-local-ref cell.6$1))))
(if or-part_0
or-part_0
(let ((vec_0 (make-vector 8 #f)))
(begin
(unsafe-place-local-set! cell.6$1 (make-weak-box vec_0))
vec_0))))))
(let ((or-part_0
(call-with-values
(lambda ()
(begin
(check-vector vec_0)
(values vec_0 (unsafe-vector-length vec_0))))
(case-lambda
((vec_1 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((s2_0 (unsafe-vector-ref vec_1 pos_0)))
(let ((result_1
(let ((result_1
(if s2_0
(if (equal? s_0 s2_0) s2_0 #f)
#f)))
(values result_1))))
(if (if (not
(let ((x_0 (list s2_0))) result_1))
#t
#f)
(for-loop_0 result_1 (unsafe-fx+ 1 pos_0))
result_1)))
result_0))))))
(for-loop_0 #f 0))))
(args (raise-binding-result-arity-error 2 args))))))
(if or-part_0
or-part_0
(begin
(unsafe-vector*-set! vec_0 (unsafe-place-local-ref cell.7) s_0)
(unsafe-place-local-set!
cell.7
(fxand (fx+ 1 (unsafe-place-local-ref cell.7)) 7))
s_0))))))
(define cache-place-init!
(lambda () (begin (resolve-cache-place-init!) (sets-place-init!))))
(define struct:scope
(make-record-type-descriptor*
'scope
#f
(|#%nongenerative-uid| scope)
#f
#f
3
4))
(define effect_2612
(struct-type-install-properties!
struct:scope
'scope
3
0
#f
(list
(cons prop:authentic #t)
(cons
prop:scope-with-bindings
(lambda (s_0 get-reachable-scopes_0 reach_0 register-trigger_0)
(binding-table-register-reachable
(scope-binding-table s_0)
get-reachable-scopes_0
reach_0
register-trigger_0)))
(cons prop:reach-scopes (lambda (s_0 reach_0) (void)))
(cons
prop:serialize-fill!
(lambda (s_0 ser-push!_0 state_0)
(if (binding-table-empty? (scope-binding-table s_0))
(|#%app| ser-push!_0 'tag #f)
(begin
(|#%app| ser-push!_0 'tag kw2576)
(|#%app|
ser-push!_0
(binding-table-prune-to-reachable
(scope-binding-table s_0)
state_0))))))
(cons
prop:serialize
(lambda (s_0 ser-push!_0 state_0)
(begin
(if (let ((s_1 (serialize-state-reachable-scopes state_0)))
(begin-unsafe (hash-ref s_1 s_0 #f)))
(void)
(error "internal error: found supposedly unreachable scope"))
(if (eq? s_0 top-level-common-scope)
(|#%app| ser-push!_0 'tag kw2129)
(begin
(|#%app| ser-push!_0 'tag kw2535)
(|#%app| ser-push!_0 (scope-kind s_0)))))))
(cons
prop:custom-write
(lambda (sc_0 port_0 mode_0)
(begin
(write-string "#<scope:" port_0)
(display (scope-id sc_0) port_0)
(write-string ":" port_0)
(display (scope-kind sc_0) port_0)
(write-string ">" port_0)))))
(current-inspector)
#f
'(0 1)
#f
'scope))
(define scope1.1
(|#%name|
scope
(record-constructor
(make-record-constructor-descriptor struct:scope #f #f))))
(define scope? (|#%name| scope? (record-predicate struct:scope)))
(define scope-id (|#%name| scope-id (record-accessor struct:scope 0)))
(define scope-kind (|#%name| scope-kind (record-accessor struct:scope 1)))
(define scope-binding-table
(|#%name| scope-binding-table (record-accessor struct:scope 2)))
(define set-scope-binding-table!
(|#%name| set-scope-binding-table! (record-mutator struct:scope 2)))
(define deserialize-scope
(case-lambda
(() top-level-common-scope)
((kind_0)
(scope1.1 (new-deserialize-scope-id!) kind_0 empty-binding-table))))
(define deserialize-scope-fill!
(lambda (s_0 bt_0) (set-scope-binding-table! s_0 bt_0)))
(define struct:interned-scope
(make-record-type-descriptor*
'interned-scope
struct:scope
(|#%nongenerative-uid| interned-scope)
#f
#f
1
0))
(define effect_2683
(struct-type-install-properties!
struct:interned-scope
'interned-scope
1
0
struct:scope
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (s_0 ser-push!_0 state_0)
(begin
(if (let ((s_1 (serialize-state-reachable-scopes state_0)))
(begin-unsafe (hash-ref s_1 s_0 #f)))
(void)
(error "internal error: found supposedly unreachable scope"))
(|#%app| ser-push!_0 'tag kw2241)
(|#%app| ser-push!_0 (interned-scope-key s_0)))))
(cons
prop:custom-write
(lambda (sc_0 port_0 mode_0)
(begin
(write-string "#<scope:" port_0)
(display (scope-id sc_0) port_0)
(write-string ":" port_0)
(display (scope-kind sc_0) port_0)
(write-string " " port_0)
(display (interned-scope-key sc_0) port_0)
(write-string ">" port_0)))))
(current-inspector)
#f
'(0)
#f
'interned-scope))
(define interned-scope2.1
(|#%name|
interned-scope
(record-constructor
(make-record-constructor-descriptor struct:interned-scope #f #f))))
(define interned-scope?
(|#%name| interned-scope? (record-predicate struct:interned-scope)))
(define interned-scope-key
(|#%name| interned-scope-key (record-accessor struct:interned-scope 0)))
(define struct:multi-scope
(make-record-type-descriptor*
'multi-scope
#f
(|#%nongenerative-uid| multi-scope)
#f
#f
5
0))
(define effect_2089
(struct-type-install-properties!
struct:multi-scope
'multi-scope
5
0
#f
(list
(cons prop:authentic #t)
(cons
prop:scope-with-bindings
(lambda (ms_0 get-reachable-scopes_0 reach_0 register-trigger_0)
(begin
(let ((ht_0 (unbox (multi-scope-scopes ms_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((sc_0 (hash-iterate-value ht_0 i_0)))
(begin
(if (binding-table-empty?
(scope-binding-table sc_0))
(void)
(|#%app| reach_0 sc_0))
(for-loop_0 (hash-iterate-next ht_0 i_0))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0)))))
(void))))
(cons prop:reach-scopes (lambda (s_0 reach_0) (void)))
(cons
prop:serialize
(lambda (ms_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2645)
(begin
(|#%app| ser-push!_0 (multi-scope-name ms_0))
(let ((multi-scope-tables_0
(serialize-state-multi-scope-tables state_0)))
(|#%app|
ser-push!_0
(let ((or-part_0
(hash-ref
multi-scope-tables_0
(multi-scope-scopes ms_0)
#f)))
(if or-part_0
or-part_0
(let ((ht_0
(let ((ht_0 (unbox (multi-scope-scopes ms_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value ht_0 i_0))
(case-lambda
((phase_0 sc_0)
(let ((table_1
(if (let ((s_0
(serialize-state-reachable-scopes
state_0)))
(begin-unsafe
(hash-ref
s_0
sc_0
#f)))
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
sc_0))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))
table_0)))
(for-loop_0
table_1
(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
(hash-set!
multi-scope-tables_0
(multi-scope-scopes ms_0)
ht_0)
ht_0)))))))))))
(current-inspector)
#f
'(0 1 2 3 4)
#f
'multi-scope))
(define multi-scope3.1
(|#%name|
multi-scope
(record-constructor
(make-record-constructor-descriptor struct:multi-scope #f #f))))
(define multi-scope?
(|#%name| multi-scope? (record-predicate struct:multi-scope)))
(define multi-scope-id
(|#%name| multi-scope-id (record-accessor struct:multi-scope 0)))
(define multi-scope-name
(|#%name| multi-scope-name (record-accessor struct:multi-scope 1)))
(define multi-scope-scopes
(|#%name| multi-scope-scopes (record-accessor struct:multi-scope 2)))
(define multi-scope-shifted
(|#%name| multi-scope-shifted (record-accessor struct:multi-scope 3)))
(define multi-scope-label-shifted
(|#%name| multi-scope-label-shifted (record-accessor struct:multi-scope 4)))
(define deserialize-multi-scope
(lambda (name_0 scopes_0)
(let ((app_0 (new-deserialize-scope-id!)))
(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
struct:scope
(|#%nongenerative-uid| representative-scope)
#f
#f
2
3))
(define effect_2236
(struct-type-install-properties!
struct:representative-scope
'representative-scope
2
0
struct:scope
(list
(cons prop:authentic #t)
(cons prop:implicitly-reachable #t)
(cons
prop:reach-scopes
(lambda (s_0 reach_0) (|#%app| reach_0 (representative-scope-owner s_0))))
(cons
prop:serialize-fill!
(lambda (s_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2073)
(|#%app|
ser-push!_0
(binding-table-prune-to-reachable (scope-binding-table s_0) state_0))
(|#%app| ser-push!_0 (representative-scope-owner s_0)))))
(cons
prop:serialize
(lambda (s_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2600)
(|#%app| ser-push!_0 (scope-kind s_0))
(|#%app| ser-push!_0 (representative-scope-phase s_0)))))
(cons
prop:custom-write
(lambda (sc_0 port_0 mode_0)
(begin
(write-string "#<scope:" port_0)
(display (scope-id sc_0) port_0)
(if (representative-scope-owner sc_0)
(begin
(write-string "=" port_0)
(display
(multi-scope-id (representative-scope-owner sc_0))
port_0))
(void))
(write-string "@" port_0)
(display (representative-scope-phase sc_0) port_0)
(write-string ">" port_0)))))
(current-inspector)
#f
'()
#f
'representative-scope))
(define representative-scope4.1
(|#%name|
representative-scope
(record-constructor
(make-record-constructor-descriptor struct:representative-scope #f #f))))
(define representative-scope?
(|#%name|
representative-scope?
(record-predicate struct:representative-scope)))
(define representative-scope-owner
(|#%name|
representative-scope-owner
(record-accessor struct:representative-scope 0)))
(define representative-scope-phase
(|#%name|
representative-scope-phase
(record-accessor struct:representative-scope 1)))
(define set-representative-scope-owner!
(|#%name|
set-representative-scope-owner!
(record-mutator struct:representative-scope 0)))
(define set-representative-scope-phase!
(|#%name|
set-representative-scope-phase!
(record-mutator struct:representative-scope 1)))
(define deserialize-representative-scope
(lambda (kind_0 phase_0)
(let ((v_0
(representative-scope4.1
(new-deserialize-scope-id!)
kind_0
#f
#f
phase_0)))
v_0)))
(define deserialize-representative-scope-fill!
(lambda (s_0 bt_0 owner_0)
(begin
(begin-unsafe (set-scope-binding-table! s_0 bt_0))
(set-representative-scope-owner! s_0 owner_0))))
(define struct:shifted-multi-scope
(make-record-type-descriptor*
'shifted-multi-scope
#f
(|#%nongenerative-uid| shifted-multi-scope)
#f
#f
2
0))
(define effect_3041
(struct-type-install-properties!
struct:shifted-multi-scope
'shifted-multi-scope
2
0
#f
(list
(cons prop:authentic #t)
(cons
prop:reach-scopes
(lambda (sms_0 reach_0)
(|#%app| reach_0 (shifted-multi-scope-multi-scope sms_0))))
(cons
prop:serialize
(lambda (sms_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2201)
(|#%app| ser-push!_0 (shifted-multi-scope-phase sms_0))
(|#%app| ser-push!_0 (shifted-multi-scope-multi-scope sms_0)))))
(cons
prop:custom-write
(lambda (sms_0 port_0 mode_0)
(begin
(write-string "#<scope:" port_0)
(display
(multi-scope-id (shifted-multi-scope-multi-scope sms_0))
port_0)
(write-string "@" port_0)
(display (shifted-multi-scope-phase sms_0) port_0)
(write-string ">" port_0)))))
(current-inspector)
#f
'(0 1)
#f
'shifted-multi-scope))
(define shifted-multi-scope5.1
(|#%name|
shifted-multi-scope
(record-constructor
(make-record-constructor-descriptor struct:shifted-multi-scope #f #f))))
(define shifted-multi-scope?
(|#%name|
shifted-multi-scope?
(record-predicate struct:shifted-multi-scope)))
(define shifted-multi-scope-phase
(|#%name|
shifted-multi-scope-phase
(record-accessor struct:shifted-multi-scope 0)))
(define shifted-multi-scope-multi-scope
(|#%name|
shifted-multi-scope-multi-scope
(record-accessor struct:shifted-multi-scope 1)))
(define deserialize-shifted-multi-scope
(lambda (phase_0 multi-scope_0)
(intern-shifted-multi-scope phase_0 multi-scope_0)))
(define intern-shifted-multi-scope
(lambda (phase_0 multi-scope_0)
(letrec*
((transaction-loop_0
(|#%name|
transaction-loop
(lambda (boxed-table_0 key_0 make_0)
(begin
(let ((or-part_0 (hash-ref (unbox boxed-table_0) phase_0 #f)))
(if or-part_0
or-part_0
(let ((val_0 (|#%app| make_0)))
(let ((current_0 (unbox boxed-table_0)))
(let ((next_0 (hash-set current_0 key_0 val_0)))
(if (unsafe-box*-cas! boxed-table_0 current_0 next_0)
val_0
(transaction-loop_0
boxed-table_0
key_0
make_0))))))))))))
(if (phase? phase_0)
(let ((or-part_0
(hash-ref
(unbox (multi-scope-shifted multi-scope_0))
phase_0
#f)))
(if or-part_0
or-part_0
(transaction-loop_0
(multi-scope-shifted multi-scope_0)
phase_0
(lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0)))))
(let ((or-part_0
(hash-ref
(unbox (multi-scope-label-shifted multi-scope_0))
phase_0
#f)))
(if or-part_0
or-part_0
(transaction-loop_0
(multi-scope-label-shifted multi-scope_0)
phase_0
(lambda () (shifted-multi-scope5.1 phase_0 multi-scope_0)))))))))
(define struct:shifted-to-label-phase
(make-record-type-descriptor*
'shifted-to-label-phase
#f
(structure-type-lookup-prefab-uid 'shifted-to-label-phase #f 1 0 #f '(0))
#f
#f
1
1))
(define effect_2490
(struct-type-install-properties!
struct:shifted-to-label-phase
'shifted-to-label-phase
1
0
#f
null
'prefab
#f
'(0)
#f
'shifted-to-label-phase))
(define shifted-to-label-phase6.1
(|#%name|
shifted-to-label-phase
(record-constructor
(make-record-constructor-descriptor struct:shifted-to-label-phase #f #f))))
(define shifted-to-label-phase?_2495
(|#%name|
shifted-to-label-phase?
(record-predicate struct:shifted-to-label-phase)))
(define shifted-to-label-phase?
(|#%name|
shifted-to-label-phase?
(lambda (v)
(if (shifted-to-label-phase?_2495 v)
#t
($value
(if (impersonator? v)
(shifted-to-label-phase?_2495 (impersonator-val v))
#f))))))
(define shifted-to-label-phase-from_2273
(|#%name|
shifted-to-label-phase-from
(record-accessor struct:shifted-to-label-phase 0)))
(define shifted-to-label-phase-from
(|#%name|
shifted-to-label-phase-from
(lambda (s)
(if (shifted-to-label-phase?_2495 s)
(shifted-to-label-phase-from_2273 s)
($value
(impersonate-ref
shifted-to-label-phase-from_2273
struct:shifted-to-label-phase
0
s
'shifted-to-label-phase
'from))))))
(define cell.1$5 (unsafe-make-place-local 0))
(define new-scope-id!
(lambda ()
(begin
(unsafe-place-local-set!
cell.1$5
(add1 (unsafe-place-local-ref cell.1$5)))
(unsafe-place-local-ref cell.1$5))))
(define new-deserialize-scope-id! (lambda () (- (new-scope-id!))))
(define deserialized-scope-id? (lambda (scope-id_0) (negative? scope-id_0)))
(define top-level-common-scope (scope1.1 0 'module empty-binding-table))
(define new-scope
(lambda (kind_0) (scope1.1 (new-scope-id!) kind_0 empty-binding-table)))
(define cell.2$2 (unsafe-make-place-local (make-weak-hasheq)))
(define scope-place-init!
(lambda () (unsafe-place-local-set! cell.2$2 (make-weak-hasheq))))
(define make-interned-scope
(lambda (sym_0)
(let ((make_0
(|#%name|
make
(lambda ()
(begin
(make-ephemeron
sym_0
(interned-scope2.1
(- (new-scope-id!))
'interned
empty-binding-table
sym_0)))))))
(call-as-atomic
(lambda ()
(let ((or-part_0
(ephemeron-value
(hash-ref! (unsafe-place-local-ref cell.2$2) sym_0 make_0))))
(if or-part_0
or-part_0
(let ((new_0 (make_0)))
(begin
(hash-set! (unsafe-place-local-ref cell.2$2) sym_0 new_0)
(ephemeron-value new_0))))))))))
(define new-multi-scope
(let ((new-multi-scope_0
(|#%name|
new-multi-scope
(lambda (name7_0)
(begin
(intern-shifted-multi-scope
0
(let ((app_0 (new-scope-id!)))
(let ((app_1 (box (hasheqv))))
(let ((app_2 (box (hasheqv))))
(multi-scope3.1
app_0
name7_0
app_1
app_2
(box (hash))))))))))))
(case-lambda
(() (new-multi-scope_0 #f))
((name7_0) (new-multi-scope_0 name7_0)))))
(define multi-scope-to-scope-at-phase
(lambda (ms_0 phase_0)
(let ((scopes_0 (unbox (multi-scope-scopes ms_0))))
(let ((or-part_0 (hash-ref scopes_0 phase_0 #f)))
(if or-part_0
or-part_0
(let ((s_0
(representative-scope4.1
(if (let ((scope-id_0 (multi-scope-id ms_0)))
(begin-unsafe (negative? scope-id_0)))
(new-deserialize-scope-id!)
(new-scope-id!))
'module
empty-binding-table
ms_0
phase_0)))
(if (unsafe-box*-cas!
(multi-scope-scopes ms_0)
scopes_0
(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) (> (scope-id sc1_0) (scope-id sc2_0))))
(define scope<? (lambda (sc1_0 sc2_0) (< (scope-id sc1_0) (scope-id sc2_0))))
(define shifted-multi-scope<?
(lambda (sms1_0 sms2_0)
(let ((ms1_0 (shifted-multi-scope-multi-scope sms1_0)))
(let ((ms2_0 (shifted-multi-scope-multi-scope sms2_0)))
(if (eq? ms1_0 ms2_0)
(let ((p1_0 (shifted-multi-scope-phase sms1_0)))
(let ((p2_0 (shifted-multi-scope-phase sms2_0)))
(if (shifted-to-label-phase? p1_0)
(if (shifted-to-label-phase? p2_0)
(let ((app_0 (shifted-to-label-phase-from p1_0)))
(phase<? app_0 (shifted-to-label-phase-from p2_0)))
#f)
(if (shifted-to-label-phase? p2_0) #t (phase<? p1_0 p2_0)))))
(< (multi-scope-id ms1_0) (multi-scope-id ms2_0)))))))
(define syntax-propagated-content*
(lambda (s_0)
(let ((content*_0 (syntax-content* s_0)))
(if (not (modified-content? content*_0))
content*_0
(let ((prop_0 (modified-content-scope-propagations+tamper content*_0)))
(if (let ((or-part_0 (propagation? prop_0)))
(if or-part_0
or-part_0
(begin-unsafe (eq? prop_0 'tainted/need-propagate))))
(let ((content_0 (modified-content-content content*_0)))
(let ((new-content_0
(if (propagation? prop_0)
(let ((f_0
(|#%name| f (lambda (tail?_0 x_0) (begin x_0)))))
(let ((s->_0
(|#%name|
s->
(lambda (sub-s_0)
(begin
(let ((sub-content*_0
(syntax-content* sub-s_0)))
(let ((sub-content_0
(if (modified-content?
sub-content*_0)
(modified-content-content
sub-content*_0)
sub-content*_0)))
(let ((scope-propagations+tamper_0
(propagation-merge
sub-content_0
prop_0
(if (modified-content?
sub-content*_0)
(modified-content-scope-propagations+tamper
sub-content*_0)
#f)
(syntax-scopes sub-s_0)
(syntax-shifted-multi-scopes
sub-s_0)
(syntax-mpi-shifts sub-s_0))))
(if (syntax?$1 sub-s_0)
(let ((scopes41_0
(propagation-apply
prop_0
(syntax-scopes sub-s_0)
s_0)))
(let ((shifted-multi-scopes42_0
(propagation-apply-shifted
prop_0
(syntax-shifted-multi-scopes
sub-s_0)
s_0)))
(let ((mpi-shifts43_0
(propagation-apply-mpi-shifts
prop_0
(syntax-mpi-shifts
sub-s_0)
s_0)))
(let ((inspector44_0
(propagation-apply-inspector
prop_0
(syntax-inspector
sub-s_0))))
(let ((content*45_0
(if scope-propagations+tamper_0
(modified-content1.1
sub-content_0
scope-propagations+tamper_0)
sub-content_0)))
(let ((inspector44_1
inspector44_0)
(mpi-shifts43_1
mpi-shifts43_0)
(shifted-multi-scopes42_1
shifted-multi-scopes42_0)
(scopes41_1
scopes41_0))
(syntax2.1
content*45_0
scopes41_1
shifted-multi-scopes42_1
mpi-shifts43_1
(syntax-srcloc
sub-s_0)
(syntax-props
sub-s_0)
inspector44_1)))))))
(raise-argument-error
'struct-copy
"syntax?"
sub-s_0))))))))))
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(s->_0 v_0)
(begin-unsafe (begin v_0))))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 s_1 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (null? s_1)
(begin-unsafe (begin s_1))
(if (pair? s_1)
(let ((x_0
(let ((app_0
(loop_0
#f
(car s_1)
depth_0)))
(cons
app_0
(loop_0
1
(cdr s_1)
depth_0)))))
(begin-unsafe (begin x_0)))
(if (symbol? s_1)
(begin-unsafe (begin s_1))
(if (boolean? s_1)
(begin-unsafe (begin s_1))
(if (number? s_1)
(begin-unsafe (begin s_1))
(if (let ((or-part_0
(vector? s_1)))
(if or-part_0
or-part_0
(let ((or-part_1
(box? s_1)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_1)))
(if or-part_2
or-part_2
(hash?
s_1)))))))
(datum-map-slow
tail?_0
s_1
(lambda (tail?_1 s_2)
(gf_0 tail?_1 s_2))
#f
#f)
(gf_0 #f s_1)))))))))))))
(loop_0 #f content_0 0))))))
(let ((f_0
(|#%name| f (lambda (tail?_0 x_0) (begin x_0)))))
(let ((s->_0
(|#%name|
s->
(lambda (sub-s_0)
(begin
(let ((t_0
(tamper-tainted-for-content
(syntax-content sub-s_0))))
(let ((content*_1
(syntax-content* sub-s_0)))
(let ((content_1
(if (modified-content?
content*_1)
(modified-content-content
content*_1)
content*_1)))
(let ((p_0
(if (modified-content?
content*_1)
(modified-content-scope-propagations+tamper
content*_1)
#f)))
(if (syntax?$1 sub-s_0)
(let ((content*46_0
(let ((new-p_0
(if (tamper? p_0)
t_0
(|#%app|
(propagation-set-tamper-ref
p_0)
p_0
t_0))))
(if new-p_0
(modified-content1.1
content_1
new-p_0)
content_1))))
(syntax2.1
content*46_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?"
sub-s_0)))))))))))
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(s->_0 v_0)
(begin-unsafe (begin v_0))))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 s_1 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (null? s_1)
(begin-unsafe (begin s_1))
(if (pair? s_1)
(let ((x_0
(let ((app_0
(loop_0
#f
(car s_1)
depth_0)))
(cons
app_0
(loop_0
1
(cdr s_1)
depth_0)))))
(begin-unsafe (begin x_0)))
(if (symbol? s_1)
(begin-unsafe (begin s_1))
(if (boolean? s_1)
(begin-unsafe (begin s_1))
(if (number? s_1)
(begin-unsafe (begin s_1))
(if (let ((or-part_0
(vector? s_1)))
(if or-part_0
or-part_0
(let ((or-part_1
(box? s_1)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_1)))
(if or-part_2
or-part_2
(hash?
s_1)))))))
(datum-map-slow
tail?_0
s_1
(lambda (tail?_1 s_2)
(gf_0 tail?_1 s_2))
#f
#f)
(gf_0 #f s_1)))))))))))))
(loop_0 #f content_0 0)))))))))
(let ((new-tamper_0
(tamper-propagated
(if (propagation? prop_0)
(propagation-tamper prop_0)
prop_0))))
(let ((new-content*_0
(if new-tamper_0
(modified-content1.1 new-content_0 new-tamper_0)
new-content_0)))
(if (begin-unsafe
(unsafe-struct*-cas! s_0 0 content*_0 new-content*_0))
new-content*_0
(syntax-propagated-content* s_0))))))
content*_0))))))
(define syntax-e/no-taint
(lambda (s_0)
(let ((content*_0 (syntax-propagated-content* s_0)))
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0))))
(define syntax-e$1
(|#%name|
syntax-e
(lambda (s_0)
(begin
(let ((e_0 (syntax-content* s_0)))
(if (symbol? e_0)
e_0
(let ((content*_0 (syntax-propagated-content* s_0)))
(if (modified-content? content*_0)
(let ((content_0 (modified-content-content content*_0)))
(let ((prop_0
(modified-content-scope-propagations+tamper
content*_0)))
(if (not (begin-unsafe (begin-unsafe (hash? prop_0))))
content_0
(if (datum-has-elements? content_0)
(taint-content content_0)
content_0))))
content*_0))))))))
(define generalize-scope
(lambda (sc_0)
(if (representative-scope? sc_0)
(let ((app_0 (representative-scope-phase sc_0)))
(intern-shifted-multi-scope app_0 (representative-scope-owner sc_0)))
sc_0)))
(define add-scope
(lambda (s_0 sc_0)
(let ((sc_1 (generalize-scope sc_0)))
(let ((op_0 set-add))
(let ((sc_2 sc_1))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(if (shifted-multi-scope? sc_2)
(if (syntax?$1 s_0)
(let ((shifted-multi-scopes47_0
(fallback-update-first
(syntax-shifted-multi-scopes s_0)
(lambda (smss_0)
(let ((s_1 (fallback-first smss_0)))
(begin-unsafe (hash-set s_1 sc_2 #t)))))))
(let ((content*48_0
(if (datum-has-elements? content_0)
(let ((prop_0
(propagation-add
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
sc_2
(syntax-scopes s_0)
(syntax-shifted-multi-scopes s_0)
(syntax-mpi-shifts s_0))))
(if prop_0
(modified-content1.1 content_0 prop_0)
content_0))
content*_0)))
(let ((shifted-multi-scopes47_1
shifted-multi-scopes47_0))
(syntax2.1
content*48_0
(syntax-scopes s_0)
shifted-multi-scopes47_1
(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))
(if (syntax?$1 s_0)
(let ((s_1 (syntax-scopes s_0)))
(let ((scopes49_0 (begin-unsafe (hash-set s_1 sc_2 #t))))
(let ((content*50_0
(if (datum-has-elements? content_0)
(let ((prop_0
(propagation-add
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
sc_2
(syntax-scopes s_0)
(syntax-shifted-multi-scopes s_0)
(syntax-mpi-shifts s_0))))
(if prop_0
(modified-content1.1 content_0 prop_0)
content_0))
content*_0)))
(let ((scopes49_1 scopes49_0))
(syntax2.1
content*50_0
scopes49_1
(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 add-scopes
(lambda (s_0 scs_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_1 lst_0)
(begin
(if (pair? lst_0)
(let ((sc_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((s_2
(let ((s_2 (add-scope s_1 sc_0))) (values s_2))))
(for-loop_0 s_2 rest_0))))
s_1))))))
(for-loop_0 s_0 scs_0)))))
(define remove-scope
(lambda (s_0 sc_0)
(let ((sc_1 (generalize-scope sc_0)))
(let ((op_0 set-remove))
(let ((sc_2 sc_1))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(if (shifted-multi-scope? sc_2)
(if (syntax?$1 s_0)
(let ((shifted-multi-scopes51_0
(fallback-update-first
(syntax-shifted-multi-scopes s_0)
(lambda (smss_0)
(let ((s_1 (fallback-first smss_0)))
(begin-unsafe (hash-remove s_1 sc_2)))))))
(let ((content*52_0
(if (datum-has-elements? content_0)
(let ((prop_0
(propagation-remove
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
sc_2
(syntax-scopes s_0)
(syntax-shifted-multi-scopes s_0)
(syntax-mpi-shifts s_0))))
(if prop_0
(modified-content1.1 content_0 prop_0)
content_0))
content*_0)))
(let ((shifted-multi-scopes51_1
shifted-multi-scopes51_0))
(syntax2.1
content*52_0
(syntax-scopes s_0)
shifted-multi-scopes51_1
(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))
(if (syntax?$1 s_0)
(let ((s_1 (syntax-scopes s_0)))
(let ((scopes53_0 (begin-unsafe (hash-remove s_1 sc_2))))
(let ((content*54_0
(if (datum-has-elements? content_0)
(let ((prop_0
(propagation-remove
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
sc_2
(syntax-scopes s_0)
(syntax-shifted-multi-scopes s_0)
(syntax-mpi-shifts s_0))))
(if prop_0
(modified-content1.1 content_0 prop_0)
content_0))
content*_0)))
(let ((scopes53_1 scopes53_0))
(syntax2.1
content*54_0
scopes53_1
(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 remove-scopes
(lambda (s_0 scs_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_1 lst_0)
(begin
(if (pair? lst_0)
(let ((sc_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((s_2
(let ((s_2 (remove-scope s_1 sc_0))) (values s_2))))
(for-loop_0 s_2 rest_0))))
s_1))))))
(for-loop_0 s_0 scs_0)))))
(define set-flip
(lambda (s_0 e_0)
(if (begin-unsafe (hash-ref s_0 e_0 #f))
(begin-unsafe (hash-remove s_0 e_0))
(begin-unsafe (hash-set s_0 e_0 #t)))))
(define flip-scope
(lambda (s_0 sc_0)
(let ((sc_1 (generalize-scope sc_0)))
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(if (shifted-multi-scope? sc_1)
(if (syntax?$1 s_0)
(let ((shifted-multi-scopes55_0
(fallback-update-first
(syntax-shifted-multi-scopes s_0)
(lambda (smss_0)
(set-flip (fallback-first smss_0) sc_1)))))
(let ((content*56_0
(if (datum-has-elements? content_0)
(let ((prop_0
(propagation-flip
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
sc_1
(syntax-scopes s_0)
(syntax-shifted-multi-scopes s_0)
(syntax-mpi-shifts s_0))))
(if prop_0
(modified-content1.1 content_0 prop_0)
content_0))
content*_0)))
(let ((shifted-multi-scopes55_1 shifted-multi-scopes55_0))
(syntax2.1
content*56_0
(syntax-scopes s_0)
shifted-multi-scopes55_1
(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))
(if (syntax?$1 s_0)
(let ((scopes57_0 (set-flip (syntax-scopes s_0) sc_1)))
(let ((content*58_0
(if (datum-has-elements? content_0)
(let ((prop_0
(propagation-flip
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
sc_1
(syntax-scopes s_0)
(syntax-shifted-multi-scopes s_0)
(syntax-mpi-shifts s_0))))
(if prop_0
(modified-content1.1 content_0 prop_0)
content_0))
content*_0)))
(let ((scopes57_1 scopes57_0))
(syntax2.1
content*58_0
scopes57_1
(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 flip-scopes
(lambda (s_0 scs_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_1 lst_0)
(begin
(if (pair? lst_0)
(let ((sc_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((s_2
(let ((s_2 (flip-scope s_1 sc_0))) (values s_2))))
(for-loop_0 s_2 rest_0))))
s_1))))))
(for-loop_0 s_0 scs_0)))))
(define push-scope
(lambda (s_0 sms_0)
(let ((smss/maybe-fallbacks59_0 #f))
(let ((prev-result_0 #f))
(let ((push_0
(|#%name|
push
(lambda (smss/maybe-fallbacks_0)
(begin
(if (eq? smss/maybe-fallbacks59_0 smss/maybe-fallbacks_0)
prev-result_0
(let ((r_0
(let ((smss_0
(fallback-first smss/maybe-fallbacks_0)))
(if (begin-unsafe (zero? (hash-count smss_0)))
(begin-unsafe (hash-set smss_0 sms_0 #t))
(if (begin-unsafe (hash-ref smss_0 sms_0 #f))
smss/maybe-fallbacks_0
(fallback-push
(begin-unsafe (hash-set smss_0 sms_0 #t))
smss/maybe-fallbacks_0))))))
(begin
(set! smss/maybe-fallbacks59_0
smss/maybe-fallbacks_0)
(set! prev-result_0 r_0)
r_0))))))))
(let ((f_0 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))))
(let ((d->s_0
(|#%name|
d->s
(lambda (s_1 d_0)
(begin
(if (syntax?$1 s_1)
(let ((content*60_0 (re-modify-content s_1 d_0)))
(let ((shifted-multi-scopes61_0
(push_0 (syntax-shifted-multi-scopes s_1))))
(let ((content*60_1 content*60_0))
(syntax2.1
content*60_1
(syntax-scopes s_1)
shifted-multi-scopes61_0
(syntax-mpi-shifts s_1)
(syntax-srcloc s_1)
(syntax-props s_1)
(syntax-inspector s_1)))))
(raise-argument-error
'struct-copy
"syntax?"
s_1)))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(d->s_0
v_0
(loop_0 (syntax-e/no-taint v_0)))
(begin-unsafe (begin v_0))))))))
(letrec*
((loop_1
(|#%name|
loop
(lambda (tail?_0 s_2 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (null? s_2)
(begin-unsafe (begin s_2))
(if (pair? s_2)
(let ((x_0
(let ((app_0
(loop_1
#f
(car s_2)
depth_0)))
(cons
app_0
(loop_1
1
(cdr s_2)
depth_0)))))
(begin-unsafe (begin x_0)))
(if (symbol? s_2)
(begin-unsafe (begin s_2))
(if (boolean? s_2)
(begin-unsafe (begin s_2))
(if (number? s_2)
(begin-unsafe (begin s_2))
(if (let ((or-part_0
(vector? s_2)))
(if or-part_0
or-part_0
(let ((or-part_1
(box? s_2)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_2)))
(if or-part_2
or-part_2
(hash? s_2)))))))
(datum-map-slow
tail?_0
s_2
(lambda (tail?_1 s_3)
(gf_0 tail?_1 s_3))
#f
#f)
(gf_0 #f s_2)))))))))))))
(loop_1 #f s_1 0)))))))))
(loop_0 s_0)))))))))
(define struct:propagation
(make-record-type-descriptor*
'propagation
#f
(|#%nongenerative-uid| propagation)
#f
#f
7
0))
(define effect_2826
(struct-type-install-properties!
struct:propagation
'propagation
7
0
#f
(list
(cons prop:authentic #t)
(cons
prop:propagation-set-tamper
(lambda (p_0 v_0) (propagation-set-tamper p_0 v_0)))
(cons prop:propagation-tamper (lambda (p_0) (propagation-tamper p_0)))
(cons prop:propagation syntax-e$1))
(current-inspector)
#f
'(0 1 2 3 4 5 6)
#f
'propagation))
(define propagation12.1
(|#%name|
propagation
(record-constructor
(make-record-constructor-descriptor struct:propagation #f #f))))
(define propagation?
(|#%name| propagation? (record-predicate struct:propagation)))
(define propagation-prev-scs
(|#%name| propagation-prev-scs (record-accessor struct:propagation 0)))
(define propagation-prev-smss
(|#%name| propagation-prev-smss (record-accessor struct:propagation 1)))
(define propagation-scope-ops
(|#%name| propagation-scope-ops (record-accessor struct:propagation 2)))
(define propagation-prev-mss
(|#%name| propagation-prev-mss (record-accessor struct:propagation 3)))
(define propagation-add-mpi-shifts
(|#%name| propagation-add-mpi-shifts (record-accessor struct:propagation 4)))
(define propagation-inspector
(|#%name| propagation-inspector (record-accessor struct:propagation 5)))
(define propagation-tamper
(|#%name| propagation-tamper (record-accessor struct:propagation 6)))
(define propagation-add
(lambda (prop_0 sc_0 prev-scs_0 prev-smss_0 prev-mss_0)
(if (propagation? prop_0)
(if (propagation? prop_0)
(let ((scope-ops63_0
(hash-set (propagation-scope-ops prop_0) sc_0 'add)))
(propagation12.1
(propagation-prev-scs prop_0)
(propagation-prev-smss prop_0)
scope-ops63_0
(propagation-prev-mss prop_0)
(propagation-add-mpi-shifts prop_0)
(propagation-inspector prop_0)
(propagation-tamper prop_0)))
(raise-argument-error 'struct-copy "propagation?" prop_0))
(propagation12.1
prev-scs_0
prev-smss_0
(hasheq sc_0 'add)
prev-mss_0
#f
#f
prop_0))))
(define propagation-remove
(lambda (prop_0 sc_0 prev-scs_0 prev-smss_0 prev-mss_0)
(if (propagation? prop_0)
(if (propagation? prop_0)
(let ((scope-ops64_0
(hash-set (propagation-scope-ops prop_0) sc_0 'remove)))
(propagation12.1
(propagation-prev-scs prop_0)
(propagation-prev-smss prop_0)
scope-ops64_0
(propagation-prev-mss prop_0)
(propagation-add-mpi-shifts prop_0)
(propagation-inspector prop_0)
(propagation-tamper prop_0)))
(raise-argument-error 'struct-copy "propagation?" prop_0))
(propagation12.1
prev-scs_0
prev-smss_0
(hasheq sc_0 'remove)
prev-mss_0
#f
#f
prop_0))))
(define propagation-flip
(lambda (prop_0 sc_0 prev-scs_0 prev-smss_0 prev-mss_0)
(if (propagation? prop_0)
(let ((ops_0 (propagation-scope-ops prop_0)))
(let ((current-op_0 (hash-ref ops_0 sc_0 #f)))
(if (if (eq? current-op_0 'flip)
(if (= 1 (hash-count ops_0))
(if (not (propagation-inspector prop_0))
(not (propagation-add-mpi-shifts prop_0))
#f)
#f)
#f)
(propagation-tamper prop_0)
(if (propagation? prop_0)
(let ((scope-ops65_0
(if (eq? current-op_0 'flip)
(hash-remove ops_0 sc_0)
(hash-set
ops_0
sc_0
(if (eq? current-op_0 'add)
'remove
(if (eq? current-op_0 'remove) 'add 'flip))))))
(propagation12.1
(propagation-prev-scs prop_0)
(propagation-prev-smss prop_0)
scope-ops65_0
(propagation-prev-mss prop_0)
(propagation-add-mpi-shifts prop_0)
(propagation-inspector prop_0)
(propagation-tamper prop_0)))
(raise-argument-error 'struct-copy "propagation?" prop_0)))))
(propagation12.1
prev-scs_0
prev-smss_0
(hasheq sc_0 'flip)
prev-mss_0
#f
#f
prop_0))))
(define propagation-mpi-shift
(lambda (prop_0 add_0 inspector_0 prev-scs_0 prev-smss_0 prev-mss_0)
(if (propagation? prop_0)
(if (propagation? prop_0)
(let ((base-add_0 (propagation-add-mpi-shifts prop_0)))
(let ((add-mpi-shifts66_0
(if (if add_0 base-add_0 #f)
(|#%name|
add-mpi-shifts66
(lambda (mss_0)
(begin (|#%app| add_0 (|#%app| base-add_0 mss_0)))))
(if add_0 add_0 base-add_0))))
(let ((inspector67_0
(let ((or-part_0 (propagation-inspector prop_0)))
(if or-part_0 or-part_0 inspector_0))))
(let ((add-mpi-shifts66_1 add-mpi-shifts66_0))
(propagation12.1
(propagation-prev-scs prop_0)
(propagation-prev-smss prop_0)
(propagation-scope-ops prop_0)
(propagation-prev-mss prop_0)
add-mpi-shifts66_1
inspector67_0
(propagation-tamper prop_0))))))
(raise-argument-error 'struct-copy "propagation?" prop_0))
(propagation12.1
prev-scs_0
prev-smss_0
hash2610
prev-mss_0
add_0
inspector_0
prop_0))))
(define propagation-apply
(lambda (prop_0 scs_0 parent-s_0)
(if (eq? (propagation-prev-scs prop_0) scs_0)
(syntax-scopes parent-s_0)
(let ((ht_0 (propagation-scope-ops prop_0)))
(let ((new-scs_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (scs_1 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
ht_0
i_0))
(case-lambda
((sc_0 op_0)
(let ((scs_2
(if (not (shifted-multi-scope? sc_0))
(let ((scs_2
(if (eq? op_0 'add)
(begin-unsafe
(hash-set scs_1 sc_0 #t))
(if (eq? op_0 'remove)
(begin-unsafe
(hash-remove scs_1 sc_0))
(set-flip scs_1 sc_0)))))
(values scs_2))
scs_1)))
(for-loop_0
scs_2
(unsafe-immutable-hash-iterate-next
ht_0
i_0))))
(args (raise-binding-result-arity-error 2 args))))
scs_1))))))
(for-loop_0
scs_0
(unsafe-immutable-hash-iterate-first ht_0))))))
(if (set=? new-scs_0 (syntax-scopes parent-s_0))
(syntax-scopes parent-s_0)
(cache-or-reuse-set new-scs_0)))))))
(define propagation-apply-shifted
(lambda (prop_0 smss_0 parent-s_0)
(if (eq? (propagation-prev-smss prop_0) smss_0)
(syntax-shifted-multi-scopes parent-s_0)
(let ((ht_0 (propagation-scope-ops prop_0)))
(let ((new-smss_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (smss_1 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
ht_0
i_0))
(case-lambda
((sms_0 op_0)
(let ((smss_2
(if (shifted-multi-scope? sms_0)
(let ((smss_2
(fallback-update-first
smss_1
(lambda (smss_2)
(if (eq? op_0 'add)
(begin-unsafe
(hash-set smss_2 sms_0 #t))
(if (eq? op_0 'remove)
(begin-unsafe
(hash-remove
smss_2
sms_0))
(set-flip
smss_2
sms_0)))))))
(values smss_2))
smss_1)))
(for-loop_0
smss_2
(unsafe-immutable-hash-iterate-next
ht_0
i_0))))
(args (raise-binding-result-arity-error 2 args))))
smss_1))))))
(for-loop_0
smss_0
(unsafe-immutable-hash-iterate-first ht_0))))))
(let ((parent-smss_0 (syntax-shifted-multi-scopes parent-s_0)))
(if (if (begin-unsafe (hash? new-smss_0))
(if (begin-unsafe (hash? parent-smss_0))
(set=? new-smss_0 parent-smss_0)
#f)
#f)
parent-smss_0
(cache-or-reuse-hash new-smss_0))))))))
(define propagation-apply-mpi-shifts
(lambda (prop_0 mss_0 parent-s_0)
(if (eq? (propagation-prev-mss prop_0) mss_0)
(syntax-mpi-shifts parent-s_0)
(let ((add_0 (propagation-add-mpi-shifts prop_0)))
(if add_0 (|#%app| add_0 mss_0) mss_0)))))
(define propagation-apply-inspector
(lambda (prop_0 i_0) (if i_0 i_0 (propagation-inspector prop_0))))
(define propagation-set-tamper
(lambda (prop_0 t_0)
(if (propagation? prop_0)
(if (propagation? prop_0)
(propagation12.1
(propagation-prev-scs prop_0)
(propagation-prev-smss prop_0)
(propagation-scope-ops prop_0)
(propagation-prev-mss prop_0)
(propagation-add-mpi-shifts prop_0)
(propagation-inspector prop_0)
t_0)
(raise-argument-error 'struct-copy "propagation?" prop_0))
t_0)))
(define propagation-merge
(lambda (content_0 prop_0 base-prop_0 prev-scs_0 prev-smss_0 prev-mss_0)
(if (not (datum-has-elements? content_0))
(if (let ((v_0 (propagation-tamper prop_0)))
(begin-unsafe (symbol? v_0)))
'tainted
base-prop_0)
(if (not (propagation? base-prop_0))
(if (if (eq? (propagation-prev-scs prop_0) prev-scs_0)
(if (eq? (propagation-prev-smss prop_0) prev-smss_0)
(if (eq? (propagation-prev-mss prop_0) prev-mss_0)
(eq? (propagation-tamper prop_0) base-prop_0)
#f)
#f)
#f)
prop_0
(propagation12.1
prev-scs_0
prev-smss_0
(propagation-scope-ops prop_0)
prev-mss_0
(propagation-add-mpi-shifts prop_0)
(propagation-inspector prop_0)
(if (let ((v_0 (propagation-tamper prop_0)))
(begin-unsafe (symbol? v_0)))
'tainted/need-propagate
base-prop_0)))
(let ((ht_0 (propagation-scope-ops prop_0)))
(let ((new-ops_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ops_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
ht_0
i_0))
(case-lambda
((sc_0 op_0)
(let ((ops_1
(let ((ops_1
(if (eq? op_0 'add)
(hash-set ops_0 sc_0 'add)
(if (eq? op_0 'remove)
(hash-set ops_0 sc_0 'remove)
(let ((current-op_0
(hash-ref
ops_0
sc_0
#f)))
(if (eq? current-op_0 'add)
(hash-set
ops_0
sc_0
'remove)
(if (eq?
current-op_0
'remove)
(hash-set
ops_0
sc_0
'add)
(if (eq?
current-op_0
'flip)
(hash-remove
ops_0
sc_0)
(hash-set
ops_0
sc_0
'flip)))))))))
(values ops_1))))
(for-loop_0
ops_1
(unsafe-immutable-hash-iterate-next
ht_0
i_0))))
(args
(raise-binding-result-arity-error 2 args))))
ops_0))))))
(for-loop_0
(propagation-scope-ops base-prop_0)
(unsafe-immutable-hash-iterate-first ht_0))))))
(let ((add_0 (propagation-add-mpi-shifts prop_0)))
(let ((base-add_0 (propagation-add-mpi-shifts base-prop_0)))
(let ((new-tamper_0
(if (let ((v_0 (propagation-tamper prop_0)))
(let ((or-part_0 (begin-unsafe (symbol? v_0))))
(if or-part_0
or-part_0
(let ((v_1 (propagation-tamper base-prop_0)))
(begin-unsafe (symbol? v_1))))))
'tainted/need-propagate
(propagation-tamper base-prop_0))))
(if (if (zero? (hash-count new-ops_0))
(if (not add_0)
(if (not base-add_0)
(if (not (propagation-inspector prop_0))
(not (propagation-inspector base-prop_0))
#f)
#f)
#f)
#f)
new-tamper_0
(if (propagation? base-prop_0)
(let ((add-mpi-shifts70_0
(if (if add_0 base-add_0 #f)
(|#%name|
add-mpi-shifts70
(lambda (mss_0)
(begin
(|#%app|
add_0
(|#%app| base-add_0 mss_0)))))
(if add_0 add_0 base-add_0))))
(let ((inspector71_0
(let ((or-part_0
(propagation-inspector base-prop_0)))
(if or-part_0
or-part_0
(propagation-inspector prop_0)))))
(let ((add-mpi-shifts70_1 add-mpi-shifts70_0))
(propagation12.1
(propagation-prev-scs base-prop_0)
(propagation-prev-smss base-prop_0)
new-ops_0
(propagation-prev-mss base-prop_0)
add-mpi-shifts70_1
inspector71_0
new-tamper_0))))
(raise-argument-error
'struct-copy
"propagation?"
base-prop_0))))))))))))
(define shift-multi-scope
(lambda (sms_0 delta_0)
(if (begin-unsafe (eq? delta_0 0))
sms_0
(if (begin-unsafe (not delta_0))
(if (shifted-to-label-phase? (shifted-multi-scope-phase sms_0))
#f
(intern-shifted-multi-scope
(shifted-to-label-phase6.1
(phase- 0 (shifted-multi-scope-phase sms_0)))
(shifted-multi-scope-multi-scope sms_0)))
(if (shifted-to-label-phase? (shifted-multi-scope-phase sms_0))
sms_0
(intern-shifted-multi-scope
(phase+ delta_0 (shifted-multi-scope-phase sms_0))
(shifted-multi-scope-multi-scope sms_0)))))))
(define syntax-shift-phase-level$1
(|#%name|
syntax-shift-phase-level
(lambda (s_0 phase_0)
(begin
(if (eqv? phase_0 0)
s_0
(let ((smss73_0 #f))
(let ((prev-result_0 #f))
(let ((shift-all_0
(|#%name|
shift-all
(lambda (smss_0)
(begin
(if (eq? smss73_0 smss_0)
prev-result_0
(let ((r_0
(fallback-map
smss_0
(lambda (smss_1)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((sms_0
(unsafe-immutable-hash-iterate-key
smss_1
i_0)))
(let ((table_1
(let ((new-sms_0
(shift-multi-scope
sms_0
phase_0)))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(if new-sms_0
(let ((table_2
(call-with-values
(lambda ()
(values
new-sms_0
#t))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))
table_1)))
table_2))))))
(for-loop_1
table_0))))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next
smss_1
i_0))))
table_0))))))
(for-loop_0
hash2610
(unsafe-immutable-hash-iterate-first
smss_1))))))))
(begin
(set! smss73_0 smss_0)
(set! prev-result_0 r_0)
r_0))))))))
(let ((f_0 (|#%name| f (lambda (tail?_0 d_0) (begin d_0)))))
(let ((d->s_0
(|#%name|
d->s
(lambda (s_1 d_0)
(begin
(if (syntax?$1 s_1)
(let ((content*74_0
(re-modify-content s_1 d_0)))
(let ((shifted-multi-scopes75_0
(shift-all_0
(syntax-shifted-multi-scopes s_1))))
(let ((content*74_1 content*74_0))
(syntax2.1
content*74_1
(syntax-scopes s_1)
shifted-multi-scopes75_0
(syntax-mpi-shifts s_1)
(syntax-srcloc s_1)
(syntax-props s_1)
(syntax-inspector s_1)))))
(raise-argument-error
'struct-copy
"syntax?"
s_1)))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(d->s_0
v_0
(loop_0 (syntax-e/no-taint v_0)))
(begin-unsafe (begin v_0))))))))
(letrec*
((loop_1
(|#%name|
loop
(lambda (tail?_0 s_2 prev-depth_0)
(begin
(let ((depth_0 (fx+ 1 prev-depth_0)))
(if (null? s_2)
(begin-unsafe (begin s_2))
(if (pair? s_2)
(let ((d_0
(let ((app_0
(loop_1
#f
(car s_2)
depth_0)))
(cons
app_0
(loop_1
1
(cdr s_2)
depth_0)))))
(begin-unsafe (begin d_0)))
(if (symbol? s_2)
(begin-unsafe (begin s_2))
(if (boolean? s_2)
(begin-unsafe (begin s_2))
(if (number? s_2)
(begin-unsafe (begin s_2))
(if (let ((or-part_0
(vector? s_2)))
(if or-part_0
or-part_0
(let ((or-part_1
(box? s_2)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_2)))
(if or-part_2
or-part_2
(hash?
s_2)))))))
(datum-map-slow
tail?_0
s_2
(lambda (tail?_1 s_3)
(gf_0 tail?_1 s_3))
#f
#f)
(gf_0 #f s_2)))))))))))))
(loop_1 #f s_1 0)))))))))
(loop_0 s_0))))))))))))
(define syntax-swap-scopes
(lambda (s_0 src-scopes_0 dest-scopes_0)
(if (equal? src-scopes_0 dest-scopes_0)
s_0
(call-with-values
(lambda ()
(let ((app_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
src-scopes_0
i_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
(generalize-scope sc_0)
#t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next
src-scopes_0
i_0))))
table_0))))))
(for-loop_0
hash2610
(unsafe-immutable-hash-iterate-first src-scopes_0))))))
(let ((app_1 (seteq)))
(set-partition app_0 shifted-multi-scope? app_1 (seteq)))))
(case-lambda
((src-smss_0 src-scs_0)
(call-with-values
(lambda ()
(let ((app_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
dest-scopes_0
i_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
(generalize-scope sc_0)
#t))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(unsafe-immutable-hash-iterate-next
dest-scopes_0
i_0))))
table_0))))))
(for-loop_0
hash2610
(unsafe-immutable-hash-iterate-first dest-scopes_0))))))
(let ((app_1 (seteq)))
(set-partition app_0 shifted-multi-scope? app_1 (seteq)))))
(case-lambda
((dest-smss_0 dest-scs_0)
(let ((src-smss_1 src-smss_0) (src-scs_1 src-scs_0))
(let ((scs76_0 #f))
(let ((prev-result_0 #f))
(let ((swap-scs_0
(|#%name|
swap-scs
(lambda (scs_0)
(begin
(if (eq? scs76_0 scs_0)
prev-result_0
(let ((r_0
(if (begin-unsafe
(hash-keys-subset?
src-scs_1
scs_0))
(set-union
(set-subtract scs_0 src-scs_1)
dest-scs_0)
scs_0)))
(begin
(set! scs76_0 scs_0)
(set! prev-result_0 r_0)
r_0))))))))
(let ((smss77_0 #f))
(let ((prev-result_1 #f))
(let ((swap-smss_0
(|#%name|
swap-smss
(lambda (smss_0)
(begin
(if (eq? smss77_0 smss_0)
prev-result_1
(let ((r_0
(fallback-update-first
smss_0
(lambda (smss_1)
(if (begin-unsafe
(hash-keys-subset?
src-smss_1
smss_1))
(set-union
(set-subtract
smss_1
src-smss_1)
dest-smss_0)
smss_1)))))
(begin
(set! smss77_0 smss_0)
(set! prev-result_1 r_0)
r_0))))))))
(let ((f_0
(|#%name|
f
(lambda (tail?_0 d_0) (begin d_0)))))
(let ((d->s_0
(|#%name|
d->s
(lambda (s_1 d_0)
(begin
(if (syntax?$1 s_1)
(let ((content*78_0
(re-modify-content s_1 d_0)))
(let ((scopes79_0
(swap-scs_0
(syntax-scopes s_1))))
(let ((shifted-multi-scopes80_0
(swap-smss_0
(syntax-shifted-multi-scopes
s_1))))
(let ((scopes79_1 scopes79_0)
(content*78_1
content*78_0))
(syntax2.1
content*78_1
scopes79_1
shifted-multi-scopes80_0
(syntax-mpi-shifts s_1)
(syntax-srcloc s_1)
(syntax-props s_1)
(syntax-inspector s_1))))))
(raise-argument-error
'struct-copy
"syntax?"
s_1)))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(let ((f_1 f_0))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(d->s_0
v_0
(loop_0
(syntax-e/no-taint
v_0)))
(begin-unsafe
(begin v_0))))))))
(letrec*
((loop_1
(|#%name|
loop
(lambda (tail?_0
s_2
prev-depth_0)
(begin
(let ((depth_0
(fx+ 1 prev-depth_0)))
(if (null? s_2)
(begin-unsafe
(begin s_2))
(if (pair? s_2)
(let ((d_0
(let ((app_0
(loop_1
#f
(car
s_2)
depth_0)))
(cons
app_0
(loop_1
1
(cdr s_2)
depth_0)))))
(begin-unsafe
(begin d_0)))
(if (symbol? s_2)
(begin-unsafe
(begin s_2))
(if (boolean? s_2)
(begin-unsafe
(begin s_2))
(if (number? s_2)
(begin-unsafe
(begin s_2))
(if (let ((or-part_0
(vector?
s_2)))
(if or-part_0
or-part_0
(let ((or-part_1
(box?
s_2)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_2)))
(if or-part_2
or-part_2
(hash?
s_2)))))))
(datum-map-slow
tail?_0
s_2
(lambda (tail?_1
s_3)
(gf_0
tail?_1
s_3))
#f
#f)
(gf_0
#f
s_2)))))))))))))
(loop_1 #f s_1 0)))))))))
(loop_0 s_0))))))))))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))))
(define syntax-scope-set
(lambda (s_0 phase_0)
(scope-set-at-fallback
s_0
(fallback-first (syntax-shifted-multi-scopes s_0))
phase_0)))
(define scope-set-at-fallback
(lambda (s_0 smss_0 phase_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (scopes_0 i_0)
(begin
(if i_0
(let ((sms_0 (unsafe-immutable-hash-iterate-key smss_0 i_0)))
(let ((scopes_1
(if (let ((or-part_0 (begin-unsafe (not phase_0))))
(if or-part_0
or-part_0
(not
(shifted-to-label-phase?
(shifted-multi-scope-phase sms_0)))))
(let ((scopes_1
(let ((e_0
(multi-scope-to-scope-at-phase
(shifted-multi-scope-multi-scope
sms_0)
(let ((ph_0
(shifted-multi-scope-phase
sms_0)))
(if (shifted-to-label-phase? ph_0)
(shifted-to-label-phase-from
ph_0)
(phase- ph_0 phase_0))))))
(begin-unsafe
(hash-set scopes_0 e_0 #t)))))
(values scopes_1))
scopes_0)))
(for-loop_0
scopes_1
(unsafe-immutable-hash-iterate-next smss_0 i_0))))
scopes_0))))))
(for-loop_0
(syntax-scopes s_0)
(unsafe-immutable-hash-iterate-first smss_0))))))
(define find-max-scope
(lambda (scopes_0)
(begin
(if (begin-unsafe (zero? (hash-count scopes_0)))
(error "cannot bind in empty scope set")
(void))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (max-sc_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key scopes_0 i_0)))
(let ((max-sc_1
(let ((max-sc_1
(if (begin-unsafe
(> (scope-id sc_0) (scope-id max-sc_0)))
sc_0
max-sc_0)))
(values max-sc_1))))
(for-loop_0
max-sc_1
(unsafe-immutable-hash-iterate-next scopes_0 i_0))))
max-sc_0))))))
(for-loop_0
(set-first scopes_0)
(unsafe-immutable-hash-iterate-first scopes_0)))))))
(define add-binding-in-scopes!.1
(|#%name|
add-binding-in-scopes!
(lambda (just-for-nominal?13_0 scopes15_0 sym16_0 binding17_0)
(begin
(let ((max-sc_0 (find-max-scope scopes15_0)))
(let ((bt_0
(binding-table-add
(scope-binding-table max-sc_0)
scopes15_0
sym16_0
binding17_0
just-for-nominal?13_0)))
(begin
(set-scope-binding-table! max-sc_0 bt_0)
(clear-resolve-cache! sym16_0))))))))
(define add-bulk-binding-in-scopes!.1
(|#%name|
add-bulk-binding-in-scopes!
(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)))
(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!))))))))
(define syntax-any-macro-scopes?
(lambda (s_0)
(let ((ht_0 (syntax-scopes s_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 i_0)
(begin
(if i_0
(let ((sc_0 (unsafe-immutable-hash-iterate-key ht_0 i_0)))
(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
(|#%name|
resolve
(lambda (ambiguous-value24_0
exactly?25_0
extra-shifts27_0
get-scopes?26_0
s32_0
phase33_0)
(begin
(let ((sym_0 (syntax-content s32_0)))
(letrec*
((fallback-loop_0
(|#%name|
fallback-loop
(lambda (smss_0)
(begin
(let ((c1_0
(if (not exactly?25_0)
(if (not get-scopes?26_0)
(resolve-cache-get
sym_0
phase33_0
(syntax-scopes s32_0)
(fallback-first smss_0))
#f)
#f)))
(if c1_0
(if (eq? c1_0 kw2450)
(if (fallback? smss_0)
(fallback-loop_0 (fallback-rest smss_0))
#f)
c1_0)
(let ((scopes_0
(scope-set-at-fallback
s32_0
(fallback-first smss_0)
phase33_0)))
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (best-scopes_0 best-binding_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
scopes_0
i_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((table_0
(scope-binding-table
sc_0)))
(if (hash? table_0)
(values
(hash-ref
table_0
sym_0
hash2725)
null)
(values
(hash-ref
(table-with-bulk-bindings-syms
table_0)
sym_0
hash2725)
(table-with-bulk-bindings-bulk-bindings
table_0)))))
(case-lambda
((ht_0 bulk-bindings_0)
(let ((s_0 s32_0))
(let ((extra-shifts_0
extra-shifts27_0))
(let ((s_1 s_0)
(ht_1 ht_0)
(bulk-bindings_1
bulk-bindings_0))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (best-scopes_1
best-binding_1
i_1)
(begin
(if (not
(null? i_1))
(let ((b-scopes_0
(if (pair?
i_1)
(bulk-binding-at-scopes
(car
i_1))
(hash-iterate-key
ht_1
i_1))))
(let ((binding_0
(if (pair?
i_1)
(let ((bulk_0
(bulk-binding-at-bulk
(car
i_1))))
(let ((b-info_0
(if (symbol-interned?
sym_0)
(hash-ref
(bulk-binding-symbols
bulk_0
s_1
extra-shifts_0)
sym_0
#f)
#f)))
(if b-info_0
(|#%app|
(begin-unsafe
(bulk-binding-class-create
(bulk-binding-ref
bulk_0)))
bulk_0
b-info_0
sym_0)
#f)))
(hash-iterate-value
ht_1
i_1))))
(let ((b-scopes_1
b-scopes_0))
(call-with-values
(lambda ()
(if (if b-scopes_1
(if binding_0
(begin-unsafe
(hash-keys-subset?
b-scopes_1
scopes_0))
#f)
#f)
(call-with-values
(lambda ()
(if (pair?
best-scopes_1)
(if (begin
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (result_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((amb-scopes_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((result_1
(let ((result_1
(begin-unsafe
(hash-keys-subset?
amb-scopes_0
b-scopes_1))))
(values
result_1))))
(if (if (not
(let ((x_0
(list
amb-scopes_0)))
(not
result_1)))
#t
#f)
(for-loop_2
result_1
rest_0)
result_1))))
result_0))))))
(for-loop_2
#t
best-scopes_1)))
(values
b-scopes_1
binding_0)
(values
(cons
b-scopes_1
best-scopes_1)
#f))
(if (not
best-scopes_1)
(values
b-scopes_1
binding_0)
(if (begin-unsafe
(hash-keys-subset?
b-scopes_1
best-scopes_1))
(values
best-scopes_1
best-binding_1)
(if (begin-unsafe
(hash-keys-subset?
best-scopes_1
b-scopes_1))
(values
b-scopes_1
binding_0)
(values
(list
best-scopes_1
b-scopes_1)
#f))))))
(case-lambda
((best-scopes_2
best-binding_2)
(values
best-scopes_2
best-binding_2))
(args
(raise-binding-result-arity-error
2
args))))
(values
best-scopes_1
best-binding_1)))
(case-lambda
((best-scopes_2
best-binding_2)
(for-loop_1
best-scopes_2
best-binding_2
(if (pair?
i_1)
(cdr
i_1)
(let ((or-part_0
(hash-iterate-next
ht_1
i_1)))
(if or-part_0
or-part_0
bulk-bindings_1)))))
(args
(raise-binding-result-arity-error
2
args)))))))
(values
best-scopes_1
best-binding_1)))))))
(for-loop_1
best-scopes_0
best-binding_0
(let ((or-part_0
(hash-iterate-first
ht_1)))
(if or-part_0
or-part_0
bulk-bindings_1)))))))))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((best-scopes_1 best-binding_1)
(for-loop_0
best-scopes_1
best-binding_1
(unsafe-immutable-hash-iterate-next
scopes_0
i_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(values
best-scopes_0
best-binding_0)))))))
(for-loop_0
#f
#f
(unsafe-immutable-hash-iterate-first
scopes_0)))))
(case-lambda
((best-scopes_0 best-binding_0)
(if (pair? best-scopes_0)
(if (fallback? smss_0)
(fallback-loop_0 (fallback-rest smss_0))
ambiguous-value24_0)
(if best-scopes_0
(begin
(resolve-cache-set!
sym_0
phase33_0
(syntax-scopes s32_0)
(fallback-first smss_0)
best-binding_0)
(if (let ((or-part_0 (not exactly?25_0)))
(if or-part_0
or-part_0
(let ((app_0
(begin-unsafe
(hash-count scopes_0))))
(eqv?
app_0
(begin-unsafe
(hash-count best-scopes_0))))))
(if get-scopes?26_0
best-scopes_0
best-binding_0)
#f))
(begin
(resolve-cache-set!
sym_0
phase33_0
(syntax-scopes s32_0)
(fallback-first smss_0)
kw2450)
(if (fallback? smss_0)
(fallback-loop_0 (fallback-rest smss_0))
#f)))))
(args
(raise-binding-result-arity-error 2 args))))))))))))
(fallback-loop_0 (syntax-shifted-multi-scopes s32_0))))))))
(define bound-identifier=?$1
(|#%name|
bound-identifier=?
(lambda (a_0 b_0 phase_0)
(begin
(if (let ((app_0 (syntax-e$1 a_0))) (eq? app_0 (syntax-e$1 b_0)))
(let ((app_0 (syntax-scope-set a_0 phase_0)))
(equal? app_0 (syntax-scope-set b_0 phase_0)))
#f)))))
(define local-binding?
(lambda (b_0)
(let ((or-part_0 (full-local-binding? b_0)))
(if or-part_0 or-part_0 (symbol? b_0)))))
(define struct:full-local-binding
(make-record-type-descriptor*
'full-local-binding
struct:full-binding
(|#%nongenerative-uid| full-local-binding)
#f
#f
1
0))
(define effect_2203
(struct-type-install-properties!
struct:full-local-binding
'full-local-binding
1
0
struct:full-binding
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (b_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2677)
(|#%app| ser-push!_0 (full-local-binding-key b_0))
(|#%app| ser-push!_0 (full-binding-free=id b_0))))))
(current-inspector)
#f
'(0)
#f
'full-local-binding))
(define full-local-binding1.1
(|#%name|
full-local-binding
(record-constructor
(make-record-constructor-descriptor struct:full-local-binding #f #f))))
(define full-local-binding?
(|#%name| full-local-binding? (record-predicate struct:full-local-binding)))
(define full-local-binding-key
(|#%name|
full-local-binding-key
(record-accessor struct:full-local-binding 0)))
(define deserialize-full-local-binding
(lambda (key_0 free=id_0) (full-local-binding1.1 #f free=id_0 key_0)))
(define make-local-binding.1
(|#%name|
make-local-binding
(lambda (frame-id2_0 free=id3_0 key6_0)
(begin
(if (if (not frame-id2_0) (not free=id3_0) #f)
key6_0
(full-local-binding1.1 frame-id2_0 free=id3_0 key6_0))))))
(define local-binding-update.1
(|#%name|
local-binding-update
(lambda (frame-id9_0 free=id10_0 key8_0 b14_0)
(begin
(let ((key_0
(if (eq? key8_0 unsafe-undefined)
(local-binding-key b14_0)
key8_0)))
(let ((frame-id_0
(if (eq? frame-id9_0 unsafe-undefined)
(binding-frame-id b14_0)
frame-id9_0)))
(let ((free=id_0
(if (eq? free=id10_0 unsafe-undefined)
(binding-free=id b14_0)
free=id10_0)))
(make-local-binding.1 frame-id_0 free=id_0 key_0))))))))
(define local-binding-key
(lambda (b_0)
(if (full-local-binding? b_0) (full-local-binding-key b_0) b_0)))
(define-values
(1/prop:rename-transformer 1/rename-transformer? rename-transformer-value)
(make-struct-type-property
'rename-transformer
(lambda (v_0 info_0)
(begin
(if (let ((or-part_0 (exact-nonnegative-integer? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (identifier? v_0)))
(if or-part_1
or-part_1
(if (procedure? v_0)
(procedure-arity-includes? v_0 1)
#f)))))
(void)
(raise-argument-error
'guard-for-prop:rename-transformer
(string-append
"(or/c exact-nonnegative-integer?\n"
" identifier?\n"
" (procedure-arity-includes? proc 1))")
v_0))
(begin
(if (exact-nonnegative-integer? v_0)
(begin
(if (<= v_0 (list-ref info_0 1))
(void)
(raise-arguments-error
'guard-for-prop:rename-transformer
"field index >= initialized-field count for structure type"
"field index"
v_0
"initialized-field count"
(list-ref info_0 1)))
(if (member v_0 (list-ref info_0 5))
(void)
(raise-arguments-error
'guard-for-prop:rename-transformer
"field index not declared immutable"
"field index"
v_0)))
(void))
(let ((ref_0 (list-ref info_0 3)))
(if (identifier? v_0)
(lambda (t_0) v_0)
(if (integer? v_0)
(lambda (t_0)
(let ((val_0 (|#%app| ref_0 t_0 v_0)))
(if (identifier? val_0) val_0 (datum->syntax$1 #f '?))))
(lambda (t_0)
(let ((id_0
(call-with-continuation-barrier
(lambda () (|#%app| v_0 t_0)))))
(begin
(if (identifier? id_0)
(void)
(raise-arguments-error
'prop:rename-transformer
"contract violation for given value; expected an identifier"
"given"
id_0))
id_0)))))))))))
(define struct:id-rename-transformer
(make-record-type-descriptor*
'rename-transformer
#f
(|#%nongenerative-uid| rename-transformer)
#f
#f
1
0))
(define effect_2777
(struct-type-install-properties!
struct:id-rename-transformer
'rename-transformer
1
0
#f
(list (cons 1/prop:rename-transformer 0))
(current-inspector)
#f
'(0)
#f
'id-rename-transformer))
(define id-rename-transformer1.1
(|#%name|
id-rename-transformer
(record-constructor
(make-record-constructor-descriptor struct:id-rename-transformer #f #f))))
(define id-rename-transformer?_2219
(|#%name|
rename-transformer?
(record-predicate struct:id-rename-transformer)))
(define id-rename-transformer?
(|#%name|
rename-transformer?
(lambda (v)
(if (id-rename-transformer?_2219 v)
#t
($value
(if (impersonator? v)
(id-rename-transformer?_2219 (impersonator-val v))
#f))))))
(define id-rename-transformer-id_2932
(|#%name|
rename-transformer-id
(record-accessor struct:id-rename-transformer 0)))
(define id-rename-transformer-id
(|#%name|
rename-transformer-id
(lambda (s)
(if (id-rename-transformer?_2219 s)
(id-rename-transformer-id_2932 s)
($value
(impersonate-ref
id-rename-transformer-id_2932
struct:id-rename-transformer
0
s
'rename-transformer
'id))))))
(define 1/make-rename-transformer
(|#%name|
make-rename-transformer
(lambda (id_0)
(begin
(begin
(if (identifier? id_0)
(void)
(raise-argument-error 'make-rename-transformer "identifier?" id_0))
(id-rename-transformer1.1 id_0))))))
(define 1/rename-transformer-target
(|#%name|
rename-transformer-target
(lambda (t_0) (begin (|#%app| (rename-transformer-value t_0) t_0)))))
(define free-identifier=?$1
(|#%name|
free-identifier=?
(lambda (a_0 b_0 a-phase_0 b-phase_0)
(begin
(let ((ab_0
(toplevel-as-symbol
(resolve+shift.1
#f
#f
null
unsafe-undefined
#t
a_0
a-phase_0))))
(let ((bb_0
(toplevel-as-symbol
(resolve+shift.1
#f
#f
null
unsafe-undefined
#t
b_0
b-phase_0))))
(if (let ((or-part_0 (symbol? ab_0)))
(if or-part_0 or-part_0 (symbol? bb_0)))
(eq? ab_0 bb_0)
(same-binding? ab_0 bb_0))))))))
(define toplevel-as-symbol
(lambda (b_0)
(if (if (module-binding? b_0)
(let ((mpi_0 (module-binding-module b_0)))
(begin-unsafe (eq? top-level-module-path-index mpi_0)))
#f)
(module-binding-sym b_0)
b_0)))
(define same-binding?
(lambda (ab_0 bb_0)
(if (module-binding? ab_0)
(if (module-binding? bb_0)
(if (let ((app_0 (module-binding-sym ab_0)))
(eq? app_0 (module-binding-sym bb_0)))
(if (let ((app_0 (module-binding-phase ab_0)))
(eqv? app_0 (module-binding-phase bb_0)))
(let ((app_0
(1/module-path-index-resolve (module-binding-module ab_0))))
(eq?
app_0
(1/module-path-index-resolve (module-binding-module bb_0))))
#f)
#f)
#f)
(if (local-binding? ab_0)
(if (local-binding? bb_0)
(let ((app_0 (local-binding-key ab_0)))
(eq? app_0 (local-binding-key bb_0)))
#f)
(error "bad binding" ab_0)))))
(define same-binding-nominals?
(lambda (ab_0 bb_0)
(if (let ((app_0
(1/module-path-index-resolve
(module-binding-nominal-module ab_0))))
(eq?
app_0
(1/module-path-index-resolve (module-binding-nominal-module bb_0))))
(if (let ((app_0 (module-binding-nominal-require-phase ab_0)))
(eqv? app_0 (module-binding-nominal-require-phase bb_0)))
(let ((app_0 (module-binding-nominal-sym ab_0)))
(eqv? app_0 (module-binding-nominal-sym bb_0)))
#f)
#f)))
(define identifier-binding-symbol$1
(|#%name|
identifier-binding-symbol
(lambda (id_0 phase_0)
(begin
(let ((b_0
(resolve+shift.1 #f #f null unsafe-undefined #t id_0 phase_0)))
(if (symbol? b_0)
b_0
(if (module-binding? b_0)
(module-binding-sym b_0)
(if (local-binding? b_0)
(local-binding-key b_0)
(syntax-e$1 id_0)))))))))
(define identifier-binding$1
(let ((identifier-binding_0
(|#%name|
identifier-binding
(lambda (id2_0 phase3_0 top-level-symbol?1_0)
(begin
(let ((b_0
(resolve+shift.1
#f
#f
null
unsafe-undefined
#f
id2_0
phase3_0)))
(if (module-binding? b_0)
(if (let ((mpi_0 (module-binding-module b_0)))
(begin-unsafe (eq? top-level-module-path-index mpi_0)))
(if top-level-symbol?1_0
(list (module-binding-nominal-sym b_0))
#f)
(let ((app_0 (module-binding-module b_0)))
(let ((app_1 (module-binding-sym b_0)))
(let ((app_2 (module-binding-nominal-module b_0)))
(let ((app_3 (module-binding-nominal-sym b_0)))
(let ((app_4 (module-binding-phase b_0)))
(let ((app_5
(module-binding-nominal-require-phase
b_0)))
(list
app_0
app_1
app_2
app_3
app_4
app_5
(module-binding-nominal-phase b_0)))))))))
(if (local-binding? b_0) 'lexical #f))))))))
(|#%name|
identifier-binding
(case-lambda
((id_0 phase_0) (begin (identifier-binding_0 id_0 phase_0 #f)))
((id_0 phase_0 top-level-symbol?1_0)
(identifier-binding_0 id_0 phase_0 top-level-symbol?1_0))))))
(define maybe-install-free=id!
(lambda (val_0 id_0 phase_0)
(if (1/rename-transformer? val_0)
(let ((free=id_0 (1/rename-transformer-target val_0)))
(if (syntax-property$1 free=id_0 'not-free-identifier=?)
(void)
(let ((b_0 (resolve+shift.1 #f #t null #t #f id_0 phase_0)))
(let ((temp50_0 (syntax-scope-set id_0 phase_0)))
(let ((temp51_0 (syntax-e$1 id_0)))
(let ((temp52_0 (binding-set-free=id b_0 free=id_0)))
(let ((temp51_1 temp51_0) (temp50_1 temp50_0))
(add-binding-in-scopes!.1
#f
temp50_1
temp51_1
temp52_0))))))))
(void))))
(define binding-set-free=id
(lambda (b_0 free=id_0)
(if (module-binding? b_0)
(module-binding-update.1
unsafe-undefined
unsafe-undefined
unsafe-undefined
free=id_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
b_0)
(if (local-binding? b_0)
(local-binding-update.1
unsafe-undefined
free=id_0
unsafe-undefined
b_0)
(error "bad binding for free=id:" b_0)))))
(define struct:non-source-shift
(make-record-type-descriptor*
'non-source-shift
#f
(structure-type-lookup-prefab-uid 'non-source-shift #f 2 0 #f '(0 1))
#f
#f
2
3))
(define effect_2830
(struct-type-install-properties!
struct:non-source-shift
'non-source-shift
2
0
#f
null
'prefab
#f
'(0 1)
#f
'non-source-shift))
(define non-source-shift4.1
(|#%name|
non-source-shift
(record-constructor
(make-record-constructor-descriptor struct:non-source-shift #f #f))))
(define non-source-shift?_2763
(|#%name| non-source-shift? (record-predicate struct:non-source-shift)))
(define non-source-shift?
(|#%name|
non-source-shift?
(lambda (v)
(if (non-source-shift?_2763 v)
#t
($value
(if (impersonator? v)
(non-source-shift?_2763 (impersonator-val v))
#f))))))
(define non-source-shift-from_3480
(|#%name| non-source-shift-from (record-accessor struct:non-source-shift 0)))
(define non-source-shift-from
(|#%name|
non-source-shift-from
(lambda (s)
(if (non-source-shift?_2763 s)
(non-source-shift-from_3480 s)
($value
(impersonate-ref
non-source-shift-from_3480
struct:non-source-shift
0
s
'non-source-shift
'from))))))
(define non-source-shift-to_2244
(|#%name| non-source-shift-to (record-accessor struct:non-source-shift 1)))
(define non-source-shift-to
(|#%name|
non-source-shift-to
(lambda (s)
(if (non-source-shift?_2763 s)
(non-source-shift-to_2244 s)
($value
(impersonate-ref
non-source-shift-to_2244
struct:non-source-shift
1
s
'non-source-shift
'to))))))
(define shift-from
(lambda (s_0) (if (pair? s_0) (car s_0) (non-source-shift-from s_0))))
(define shift-to
(lambda (s_0) (if (pair? s_0) (cdr s_0) (non-source-shift-to s_0))))
(define syntax-module-path-index-shift.1
(|#%name|
syntax-module-path-index-shift
(lambda (non-source?5_0 s8_0 from-mpi9_0 to-mpi10_0 inspector7_0)
(begin
(if (eq? from-mpi9_0 to-mpi10_0)
(if inspector7_0 (syntax-set-inspector s8_0 inspector7_0) s8_0)
(let ((shift_0
(if non-source?5_0
(non-source-shift4.1 from-mpi9_0 to-mpi10_0)
(cons from-mpi9_0 to-mpi10_0))))
(let ((content*_0 (syntax-content* s8_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(if (syntax?$1 s8_0)
(let ((mpi-shifts62_0
(shift-cons shift_0 (syntax-mpi-shifts s8_0))))
(let ((inspector63_0
(let ((or-part_0 (syntax-inspector s8_0)))
(if or-part_0 or-part_0 inspector7_0))))
(let ((content*64_0
(if (datum-has-elements? content_0)
(modified-content1.1
content_0
(propagation-mpi-shift
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
(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))
(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)
(if (if (pair? shifts_0)
(let ((app_0 (shift-from shift_0)))
(eq? app_0 (shift-from (car shifts_0))))
#f)
shifts_0
(cons shift_0 shifts_0))))
(define resolve+shift.1
(|#%name|
resolve+shift
(lambda (ambiguous-value12_0
exactly?13_0
extra-shifts16_0
immediate?14_0
unbound-sym?15_0
s22_0
phase23_0)
(begin
(let ((immediate?_0
(if (eq? immediate?14_0 unsafe-undefined)
exactly?13_0
immediate?14_0)))
(let ((can-cache?_0
(if (not exactly?13_0)
(if (not immediate?_0) (null? extra-shifts16_0) #f)
#f)))
(let ((c1_0
(if can-cache?_0
(resolve+shift-cache-get s22_0 phase23_0)
#f)))
(if c1_0
(if (eq? c1_0 kw2450)
(if unbound-sym?15_0 (syntax-content s22_0) #f)
c1_0)
(let ((immediate-b_0
(resolve.1
ambiguous-value12_0
exactly?13_0
extra-shifts16_0
#f
s22_0
phase23_0)))
(let ((b_0
(if (if immediate-b_0
(if (not immediate?_0)
(binding-free=id immediate-b_0)
#f)
#f)
(let ((temp70_0 (binding-free=id immediate-b_0)))
(let ((temp72_0
(append
extra-shifts16_0
(syntax-mpi-shifts s22_0))))
(let ((temp70_1 temp70_0))
(resolve+shift.1
ambiguous-value12_0
exactly?13_0
temp72_0
unsafe-undefined
unbound-sym?15_0
temp70_1
phase23_0))))
immediate-b_0)))
(if (module-binding? b_0)
(let ((mpi-shifts_0 (syntax-mpi-shifts s22_0)))
(if (null? mpi-shifts_0)
b_0
(let ((mod_0 (module-binding-module b_0)))
(let ((shifted-mod_0
(apply-syntax-shifts mod_0 mpi-shifts_0)))
(let ((nominal-mod_0
(module-binding-nominal-module b_0)))
(let ((shifted-nominal-mod_0
(if (eq? mod_0 nominal-mod_0)
shifted-mod_0
(apply-syntax-shifts
nominal-mod_0
mpi-shifts_0))))
(let ((result-b_0
(if (if (eq? mod_0 shifted-mod_0)
(if (eq?
nominal-mod_0
shifted-nominal-mod_0)
(if (not (binding-free=id b_0))
(null?
(module-binding-extra-nominal-bindings
b_0))
#f)
#f)
#f)
b_0
(let ((temp79_0
(if (binding-free=id b_0)
(let ((temp81_0
(binding-free=id
b_0)))
(syntax-transfer-shifts.1
#f
temp81_0
s22_0
#f))
#f)))
(let ((temp80_0
(reverse$1
(let ((lst_0
(module-binding-extra-nominal-bindings
b_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((b_1
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(apply-syntax-shifts-to-binding
b_1
mpi-shifts_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
lst_0)))))))
(let ((temp79_1 temp79_0))
(module-binding-update.1
unsafe-undefined
temp80_0
unsafe-undefined
temp79_1
shifted-mod_0
shifted-nominal-mod_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
b_0)))))))
(begin
(if can-cache?_0
(resolve+shift-cache-set!
s22_0
phase23_0
result-b_0)
(void))
result-b_0))))))))
(begin
(if can-cache?_0
(resolve+shift-cache-set!
s22_0
phase23_0
(if b_0 b_0 kw2450))
(void))
(if b_0
b_0
(if unbound-sym?15_0
(syntax-content s22_0)
#f))))))))))))))
(define apply-syntax-shifts
(lambda (mpi_0 shifts_0)
(if (null? shifts_0)
mpi_0
(let ((shifted-mpi_0 (apply-syntax-shifts mpi_0 (cdr shifts_0))))
(let ((shift_0 (car shifts_0)))
(let ((app_0 (shift-from shift_0)))
(module-path-index-shift
shifted-mpi_0
app_0
(shift-to shift_0))))))))
(define apply-syntax-shifts-to-binding
(lambda (b_0 shifts_0)
(if (null? shifts_0)
b_0
(let ((shifted-b_0 (apply-syntax-shifts-to-binding b_0 (cdr shifts_0))))
(let ((shift_0 (car shifts_0)))
(let ((app_0 (shift-from shift_0)))
(binding-module-path-index-shift
shifted-b_0
app_0
(shift-to shift_0))))))))
(define binding-module-path-index-shift
(lambda (b_0 from-mpi_0 to-mpi_0)
(if (module-binding? b_0)
(let ((temp84_0
(module-path-index-shift
(module-binding-module b_0)
from-mpi_0
to-mpi_0)))
(let ((temp85_0
(module-path-index-shift
(module-binding-nominal-module b_0)
from-mpi_0
to-mpi_0)))
(let ((temp86_0
(reverse$1
(let ((lst_0 (module-binding-extra-nominal-bindings b_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((b_1 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(binding-module-path-index-shift
b_1
from-mpi_0
to-mpi_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
(let ((temp85_1 temp85_0) (temp84_1 temp84_0))
(module-binding-update.1
unsafe-undefined
temp86_0
unsafe-undefined
unsafe-undefined
temp84_1
temp85_1
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
b_0)))))
b_0)))
(define syntax-transfer-shifts.1
(|#%name|
syntax-transfer-shifts
(lambda (non-source?25_0 to-s28_0 from-s29_0 inspector27_0)
(begin
(let ((temp88_0 (syntax-mpi-shifts from-s29_0)))
(syntax-add-shifts.1
non-source?25_0
to-s28_0
temp88_0
inspector27_0))))))
(define syntax-add-shifts.1
(|#%name|
syntax-add-shifts
(lambda (non-source?31_0 to-s34_0 shifts35_0 inspector33_0)
(begin
(if (if (null? shifts35_0) inspector33_0 #f)
(syntax-set-inspector to-s34_0 inspector33_0)
(let ((lst_0 (reverse$1 shifts35_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_0 lst_1 pos_0)
(begin
(if (if (pair? lst_1) #t #f)
(let ((shift_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((s_1
(let ((s_1
(let ((temp92_0 (shift-from shift_0)))
(let ((temp93_0 (shift-to shift_0)))
(let ((temp94_0
(if (zero? pos_0)
inspector33_0
#f)))
(let ((temp93_1 temp93_0)
(temp92_1 temp92_0))
(syntax-module-path-index-shift.1
non-source?31_0
s_0
temp92_1
temp93_1
temp94_0)))))))
(values s_1))))
(for-loop_0 s_1 rest_0 (+ pos_0 1)))))
s_0))))))
(for-loop_0 to-s34_0 lst_0 0)))))))))
(define syntax-set-inspector
(lambda (s_0 insp_0)
(let ((content*_0 (syntax-content* s_0)))
(let ((content_0
(if (modified-content? content*_0)
(modified-content-content content*_0)
content*_0)))
(if (syntax?$1 s_0)
(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
(propagation-mpi-shift
(if (modified-content? content*_0)
(modified-content-scope-propagations+tamper
content*_0)
#f)
#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
(|#%name|
syntax-source-module
(lambda (s38_0 source?37_0)
(begin
(begin
(if (syntax?$1 s38_0)
(void)
(raise-argument-error 'syntax-track-origin "syntax?" s38_0))
(let ((lst_0 (reverse$1 (syntax-mpi-shifts s38_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((shift_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1
(if (non-source-shift? shift_0)
result_0
(let ((result_1
(let ((from-mpi_0
(car shift_0)))
(call-with-values
(lambda ()
(1/module-path-index-split
from-mpi_0))
(case-lambda
((path_0 base_0)
(if (not path_0)
(if (module-path-index-resolved
from-mpi_0)
(let ((mpi_0
(apply-syntax-shifts
from-mpi_0
(syntax-mpi-shifts
s38_0))))
(if source?37_0
(1/resolved-module-path-name
(1/module-path-index-resolve
mpi_0
#f))
mpi_0))
#f)
#f))
(args
(raise-binding-result-arity-error
2
args)))))))
(values result_1)))))
(if (if (not
(let ((x_0 (list shift_0)))
result_1))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #f lst_0))))))))))
(|#%name|
syntax-source-module
(case-lambda
((s_0) (begin (syntax-source-module_0 s_0 #f)))
((s_0 source?37_0) (syntax-source-module_0 s_0 source?37_0))))))
(define 1/identifier-prune-to-source-module
(|#%name|
identifier-prune-to-source-module
(lambda (id_0)
(begin
(begin
(if (identifier? id_0)
(void)
(raise-argument-error
'identifier-prune-to-source-module
"identifier?"
id_0))
(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)))
(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
(|#%nongenerative-uid| provided)
#f
#f
3
0))
(define effect_2693
(struct-type-install-properties!
struct:provided
'provided
3
0
#f
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (p_0 ser-push!_0 state_0)
(begin
(|#%app| ser-push!_0 'tag kw2897)
(|#%app| ser-push!_0 (provided-binding p_0))
(|#%app| ser-push!_0 (provided-protected? p_0))
(|#%app| ser-push!_0 (provided-syntax? p_0))))))
#f
#f
'(0 1 2)
#f
'provided))
(define provided1.1
(|#%name|
provided
(record-constructor
(make-record-constructor-descriptor struct:provided #f #f))))
(define provided? (|#%name| provided? (record-predicate struct:provided)))
(define provided-binding
(|#%name| provided-binding (record-accessor struct:provided 0)))
(define provided-protected?
(|#%name| provided-protected? (record-accessor struct:provided 1)))
(define provided-syntax?
(|#%name| provided-syntax? (record-accessor struct:provided 2)))
(define provided-as-binding
(lambda (v_0) (if (provided? v_0) (provided-binding v_0) v_0)))
(define provided-as-protected?
(lambda (v_0) (if (provided? v_0) (provided-protected? v_0) #f)))
(define provided-as-transformer?
(lambda (v_0) (if (provided? v_0) (provided-syntax? v_0) #f)))
(define deserialize-provided
(lambda (binding_0 protected?_0 syntax?_0)
(provided1.1 binding_0 protected?_0 syntax?_0)))
(define provide-binding-to-require-binding.1
(|#%name|
provide-binding-to-require-binding
(lambda (mpi2_0
phase-shift4_0
provide-phase-level3_0
self1_0
binding/p9_0
sym10_0)
(begin
(let ((binding_0 (provided-as-binding binding/p9_0)))
(let ((from-mod_0 (module-binding-module binding_0)))
(let ((temp16_0
(module-path-index-shift from-mod_0 self1_0 mpi2_0)))
(let ((temp22_0
(if (not (provided-as-protected? binding/p9_0))
(module-binding-extra-inspector binding_0)
#f)))
(let ((temp16_1 temp16_0))
(module-binding-update.1
temp22_0
null
#f
unsafe-undefined
temp16_1
mpi2_0
provide-phase-level3_0
phase-shift4_0
sym10_0
unsafe-undefined
unsafe-undefined
binding_0))))))))))
(define struct:bulk-binding
(make-record-type-descriptor*
'bulk-binding
#f
(|#%nongenerative-uid| bulk-binding)
#f
#f
8
9))
(define effect_2831
(struct-type-install-properties!
struct:bulk-binding
'bulk-binding
8
0
#f
(list
(cons prop:authentic #t)
(cons
prop:serialize
(lambda (b_0 ser-push!_0 reachable-scopes_0)
(begin
(|#%app| ser-push!_0 'tag kw2762)
(|#%app| ser-push!_0 (bulk-binding-prefix b_0))
(|#%app| ser-push!_0 (bulk-binding-excepts b_0))
(|#%app| ser-push!_0 (bulk-binding-mpi b_0))
(|#%app| ser-push!_0 (bulk-binding-provide-phase-level b_0))
(|#%app| ser-push!_0 (bulk-binding-phase-shift b_0))
(|#%app| ser-push!_0 'tag kw2607))))
(cons
prop:bulk-binding
(bulk-binding-class3.1
(lambda (b_0 mpi-shifts_0)
(let ((or-part_0 (bulk-binding-provides b_0)))
(if or-part_0
or-part_0
(let ((mod-name_0
(1/module-path-index-resolve
(apply-syntax-shifts
(bulk-binding-mpi b_0)
mpi-shifts_0))))
(begin
(if (bulk-binding-bulk-binding-registry b_0)
(void)
(error
"namespace mismatch: no bulk-binding registry available:"
mod-name_0))
(let ((table_0
(bulk-binding-registry-table
(bulk-binding-bulk-binding-registry b_0))))
(let ((bulk-provide_0 (hash-ref table_0 mod-name_0 #f)))
(begin
(if bulk-provide_0
(void)
(error
"namespace mismatch: bulk bindings not found in registry for module:"
mod-name_0))
(begin
(set-bulk-binding-self!
b_0
(bulk-provide-self bulk-provide_0))
(let ((provides_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
(if (if prefix_0
prefix_0
(positive? (hash-count excepts_0)))
(bulk-provides-add-prefix-remove-exceptions
provides_0
prefix_0
excepts_0)
provides_0)))
(begin
(set-bulk-binding-provides!
b_0
adjusted-provides_0)
adjusted-provides_0))))))))))))))
(lambda (b_0 binding_0 sym_0)
(let ((temp26_0
(if (bulk-binding-prefix b_0)
(string->symbol
(let ((app_0 (symbol->string sym_0)))
(substring
app_0
(string-length
(symbol->string (bulk-binding-prefix b_0))))))
sym_0)))
(let ((temp27_0 (bulk-binding-self b_0)))
(let ((temp28_0 (bulk-binding-mpi b_0)))
(let ((temp29_0 (bulk-binding-provide-phase-level b_0)))
(let ((temp30_0 (bulk-binding-phase-shift b_0)))
(let ((temp29_1 temp29_0)
(temp28_1 temp28_0)
(temp27_1 temp27_0)
(temp26_1 temp26_0))
(provide-binding-to-require-binding.1
temp28_1
temp30_0
temp29_1
temp27_1
binding_0
temp26_1)))))))))))
(current-inspector)
#f
'(1 2 4 5 6 7)
#f
'bulk-binding))
(define bulk-binding12.1
(|#%name|
bulk-binding
(record-constructor
(make-record-constructor-descriptor struct:bulk-binding #f #f))))
(define bulk-binding?
(|#%name| bulk-binding? (record-predicate struct:bulk-binding)))
(define bulk-binding-provides
(|#%name| bulk-binding-provides (record-accessor struct:bulk-binding 0)))
(define bulk-binding-prefix
(|#%name| bulk-binding-prefix (record-accessor struct:bulk-binding 1)))
(define bulk-binding-excepts
(|#%name| bulk-binding-excepts (record-accessor struct:bulk-binding 2)))
(define bulk-binding-self
(|#%name| bulk-binding-self (record-accessor struct:bulk-binding 3)))
(define bulk-binding-mpi
(|#%name| bulk-binding-mpi (record-accessor struct:bulk-binding 4)))
(define bulk-binding-provide-phase-level
(|#%name|
bulk-binding-provide-phase-level
(record-accessor struct:bulk-binding 5)))
(define bulk-binding-phase-shift
(|#%name| bulk-binding-phase-shift (record-accessor struct:bulk-binding 6)))
(define bulk-binding-bulk-binding-registry
(|#%name|
bulk-binding-bulk-binding-registry
(record-accessor struct:bulk-binding 7)))
(define set-bulk-binding-provides!
(|#%name| set-bulk-binding-provides! (record-mutator struct:bulk-binding 0)))
(define set-bulk-binding-self!
(|#%name| set-bulk-binding-self! (record-mutator struct:bulk-binding 3)))
(define deserialize-bulk-binding
(lambda (prefix_0
excepts_0
mpi_0
provide-phase-level_0
phase-shift_0
bulk-binding-registry_0)
(bulk-binding12.1
#f
prefix_0
excepts_0
#f
mpi_0
provide-phase-level_0
phase-shift_0
bulk-binding-registry_0)))
(define bulk-provides-add-prefix-remove-exceptions
(lambda (provides_0 prefix_0 excepts_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value provides_0 i_0))
(case-lambda
((sym_0 val_0)
(let ((table_1
(if (hash-ref excepts_0 sym_0 #f)
table_0
(if (symbol-interned? sym_0)
(let ((table_1
(call-with-values
(lambda ()
(values
(if prefix_0
(string->symbol
(format "~a~a" prefix_0 sym_0))
sym_0)
val_0))
(case-lambda
((key_0 val_1)
(hash-set table_0 key_0 val_1))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))
table_0))))
(for-loop_0 table_1 (hash-iterate-next provides_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2725 (hash-iterate-first provides_0))))))
(define struct:bulk-provide
(make-record-type-descriptor*
'bulk-provide
#f
(|#%nongenerative-uid| bulk-provide)
#f
#f
2
0))
(define effect_2367
(struct-type-install-properties!
struct:bulk-provide
'bulk-provide
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'bulk-provide))
(define bulk-provide13.1
(|#%name|
bulk-provide
(record-constructor
(make-record-constructor-descriptor struct:bulk-provide #f #f))))
(define bulk-provide?_2131
(|#%name| bulk-provide? (record-predicate struct:bulk-provide)))
(define bulk-provide?
(|#%name|
bulk-provide?
(lambda (v)
(if (bulk-provide?_2131 v)
#t
($value
(if (impersonator? v)
(bulk-provide?_2131 (impersonator-val v))
#f))))))
(define bulk-provide-self_2134
(|#%name| bulk-provide-self (record-accessor struct:bulk-provide 0)))
(define bulk-provide-self
(|#%name|
bulk-provide-self
(lambda (s)
(if (bulk-provide?_2131 s)
(bulk-provide-self_2134 s)
($value
(impersonate-ref
bulk-provide-self_2134
struct:bulk-provide
0
s
'bulk-provide
'self))))))
(define bulk-provide-provides_2573
(|#%name| bulk-provide-provides (record-accessor struct:bulk-provide 1)))
(define bulk-provide-provides
(|#%name|
bulk-provide-provides
(lambda (s)
(if (bulk-provide?_2131 s)
(bulk-provide-provides_2573 s)
($value
(impersonate-ref
bulk-provide-provides_2573
struct:bulk-provide
1
s
'bulk-provide
'provides))))))
(define struct:bulk-binding-registry
(make-record-type-descriptor*
'bulk-binding-registry
#f
(|#%nongenerative-uid| bulk-binding-registry)
#f
#f
1
0))
(define effect_2382
(struct-type-install-properties!
struct:bulk-binding-registry
'bulk-binding-registry
1
0
#f
null
(current-inspector)
#f
'(0)
#f
'bulk-binding-registry))
(define bulk-binding-registry14.1
(|#%name|
bulk-binding-registry
(record-constructor
(make-record-constructor-descriptor struct:bulk-binding-registry #f #f))))
(define bulk-binding-registry?_2831
(|#%name|
bulk-binding-registry?
(record-predicate struct:bulk-binding-registry)))
(define bulk-binding-registry?
(|#%name|
bulk-binding-registry?
(lambda (v)
(if (bulk-binding-registry?_2831 v)
#t
($value
(if (impersonator? v)
(bulk-binding-registry?_2831 (impersonator-val v))
#f))))))
(define bulk-binding-registry-table_2379
(|#%name|
bulk-binding-registry-table
(record-accessor struct:bulk-binding-registry 0)))
(define bulk-binding-registry-table
(|#%name|
bulk-binding-registry-table
(lambda (s)
(if (bulk-binding-registry?_2831 s)
(bulk-binding-registry-table_2379 s)
($value
(impersonate-ref
bulk-binding-registry-table_2379
struct:bulk-binding-registry
0
s
'bulk-binding-registry
'table))))))
(define make-bulk-binding-registry
(lambda () (bulk-binding-registry14.1 (make-hasheq))))
(define register-bulk-provide!
(lambda (bulk-binding-registry_0 mod-name_0 self_0 provides_0)
(let ((app_0 (bulk-binding-registry-table bulk-binding-registry_0)))
(hash-set! app_0 mod-name_0 (bulk-provide13.1 self_0 provides_0)))))
(define registered-bulk-provide?
(lambda (bulk-binding-registry_0 mod-name_0)
(if (hash-ref
(bulk-binding-registry-table bulk-binding-registry_0)
mod-name_0
#f)
#t
#f)))
(define generate-lift-key (lambda () (gensym 'lift)))
(define struct:root-expand-context/outer
(make-record-type-descriptor*
'root-expand-context
#f
(|#%nongenerative-uid| root-expand-context)
#f
#f
4
0))
(define effect_2573
(struct-type-install-properties!
struct:root-expand-context/outer
'root-expand-context
4
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3)
#f
'root-expand-context/outer))
(define root-expand-context/outer1.1
(|#%name|
root-expand-context/outer
(record-constructor
(make-record-constructor-descriptor
struct:root-expand-context/outer
#f
#f))))
(define root-expand-context/outer?
(|#%name|
root-expand-context?
(record-predicate struct:root-expand-context/outer)))
(define root-expand-context/outer-inner
(|#%name|
root-expand-context-inner
(record-accessor struct:root-expand-context/outer 0)))
(define root-expand-context/outer-post-expansion
(|#%name|
root-expand-context-post-expansion
(record-accessor struct:root-expand-context/outer 1)))
(define root-expand-context/outer-use-site-scopes
(|#%name|
root-expand-context-use-site-scopes
(record-accessor struct:root-expand-context/outer 2)))
(define root-expand-context/outer-frame-id
(|#%name|
root-expand-context-frame-id
(record-accessor struct:root-expand-context/outer 3)))
(define struct:root-expand-context/inner
(make-record-type-descriptor*
'root-expand-context/inner
#f
(|#%nongenerative-uid| root-expand-context/inner)
#f
#f
7
0))
(define effect_2774
(struct-type-install-properties!
struct:root-expand-context/inner
'root-expand-context/inner
7
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6)
#f
'root-expand-context/inner))
(define root-expand-context/inner2.1
(|#%name|
root-expand-context/inner
(record-constructor
(make-record-constructor-descriptor
struct:root-expand-context/inner
#f
#f))))
(define root-expand-context/inner?
(|#%name|
root-expand-context/inner?
(record-predicate struct:root-expand-context/inner)))
(define root-expand-context/inner-self-mpi
(|#%name|
root-expand-context/inner-self-mpi
(record-accessor struct:root-expand-context/inner 0)))
(define root-expand-context/inner-module-scopes
(|#%name|
root-expand-context/inner-module-scopes
(record-accessor struct:root-expand-context/inner 1)))
(define root-expand-context/inner-top-level-bind-scope
(|#%name|
root-expand-context/inner-top-level-bind-scope
(record-accessor struct:root-expand-context/inner 2)))
(define root-expand-context/inner-all-scopes-stx
(|#%name|
root-expand-context/inner-all-scopes-stx
(record-accessor struct:root-expand-context/inner 3)))
(define root-expand-context/inner-defined-syms
(|#%name|
root-expand-context/inner-defined-syms
(record-accessor struct:root-expand-context/inner 4)))
(define root-expand-context/inner-counter
(|#%name|
root-expand-context/inner-counter
(record-accessor struct:root-expand-context/inner 5)))
(define root-expand-context/inner-lift-key
(|#%name|
root-expand-context/inner-lift-key
(record-accessor struct:root-expand-context/inner 6)))
(define root-expand-context/make
(lambda (self-mpi_0
module-scopes_0
post-expansion_0
top-level-bind-scope_0
all-scopes-stx_0
use-site-scopes_0
defined-syms_0
frame-id_0
counter_0
lift-key_0)
(root-expand-context/outer1.1
(root-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)
post-expansion_0
use-site-scopes_0
frame-id_0)))
(define root-expand-context-post-expansion
(lambda (v_0) (root-expand-context/outer-post-expansion v_0)))
(define root-expand-context-use-site-scopes
(lambda (v_0) (root-expand-context/outer-use-site-scopes v_0)))
(define root-expand-context-frame-id
(lambda (v_0) (root-expand-context/outer-frame-id v_0)))
(define root-expand-context-self-mpi
(lambda (v_0)
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner v_0))))
(define root-expand-context-module-scopes
(lambda (v_0)
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner v_0))))
(define root-expand-context-top-level-bind-scope
(lambda (v_0)
(root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner v_0))))
(define root-expand-context-all-scopes-stx
(lambda (v_0)
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner v_0))))
(define root-expand-context-defined-syms
(lambda (v_0)
(root-expand-context/inner-defined-syms
(root-expand-context/outer-inner v_0))))
(define root-expand-context-counter
(lambda (v_0)
(root-expand-context/inner-counter (root-expand-context/outer-inner v_0))))
(define root-expand-context-lift-key
(lambda (v_0)
(root-expand-context/inner-lift-key
(root-expand-context/outer-inner v_0))))
(define make-root-expand-context.1
(|#%name|
make-root-expand-context
(lambda (all-scopes-stx7_0
initial-scopes4_0
outside-scope5_0
post-expansion-scope6_0
self-mpi3_0)
(begin
(let ((outside-scope_0
(if (eq? outside-scope5_0 unsafe-undefined)
top-level-common-scope
outside-scope5_0)))
(let ((post-expansion-scope_0
(if (eq? post-expansion-scope6_0 unsafe-undefined)
(new-multi-scope 'top-level)
post-expansion-scope6_0)))
(let ((module-scopes_0
(list*
post-expansion-scope_0
outside-scope_0
initial-scopes4_0)))
(let ((top-level-bind-scope_0 (new-scope 'module)))
(let ((all-scopes-stx_0
(if all-scopes-stx7_0
all-scopes-stx7_0
(add-scopes empty-syntax module-scopes_0))))
(let ((use-site-scopes_0 (box null)))
(let ((defined-syms_0 (make-hasheqv)))
(let ((frame-id_0
(string->uninterned-symbol "root-frame")))
(let ((counter_0 (box 0)))
(let ((lift-key_0 (generate-lift-key)))
(let ((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))
(begin-unsafe
(root-expand-context/outer1.1
(root-expand-context/inner2.1
self-mpi3_0
module-scopes_0
top-level-bind-scope_1
all-scopes-stx_1
defined-syms_1
counter_1
lift-key_0)
post-expansion-scope_0
use-site-scopes_1
frame-id_1)))))))))))))))))
(define apply-post-expansion
(lambda (pe_0 s_0)
(if (not pe_0)
s_0
(if (shifted-multi-scope? pe_0)
(push-scope s_0 pe_0)
(if (pair? pe_0)
(let ((temp16_0 (push-scope s_0 (car pe_0))))
(let ((temp17_0 (cdr pe_0)))
(let ((temp16_1 temp16_0))
(syntax-add-shifts.1 #f temp16_1 temp17_0 #f))))
(|#%app| pe_0 s_0))))))
(define post-expansion-scope
(lambda (pe_0)
(if (shifted-multi-scope? pe_0)
pe_0
(if (pair? pe_0)
(car pe_0)
(error
'post-expansion-scope
"internal error: cannot extract scope from ~s"
pe_0)))))
(define root-expand-context-encode-for-module
(lambda (ctx_0 orig-self_0 new-self_0)
(datum->syntax$1
#f
(let ((app_0
(add-scopes
empty-syntax
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner ctx_0))))))
(let ((app_1
(apply-post-expansion
(begin-unsafe (root-expand-context/outer-post-expansion ctx_0))
empty-syntax)))
(let ((app_2
(let ((temp18_0
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner ctx_0)))))
(syntax-module-path-index-shift.1
#f
temp18_0
orig-self_0
new-self_0
#f))))
(let ((app_3
(add-scopes
empty-syntax
(unbox
(begin-unsafe
(root-expand-context/outer-use-site-scopes ctx_0))))))
(let ((app_4
(let ((ht_0
(begin-unsafe
(root-expand-context/inner-defined-syms
(root-expand-context/outer-inner ctx_0)))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value ht_0 i_0))
(case-lambda
((phase_0 ht_1)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values phase_0 ht_1))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(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)))))))
(vector
app_0
app_1
app_2
app_3
app_4
(begin-unsafe (root-expand-context/outer-frame-id ctx_0))
(unbox
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner ctx_0)))))))))))))
(define root-expand-context-decode-for-module
(lambda (vec-s_0 self_0)
(let ((vec_0 (if (syntax?$1 vec-s_0) (syntax-e$1 vec-s_0) #f)))
(begin
(if (if (vector? vec_0)
(if (= (vector-length vec_0) 7)
(if (syntax?$1 (vector-ref vec_0 0))
(if (syntax-with-one-scope? (vector-ref vec_0 1))
(if (syntax?$1 (vector-ref vec_0 2))
(if (syntax?$1 (vector-ref vec_0 3))
(if (defined-syms-hash?
(syntax-e$1 (vector-ref vec_0 4)))
(if (symbol? (syntax-e$1 (vector-ref vec_0 5)))
(exact-nonnegative-integer?
(syntax-e$1 (vector-ref vec_0 6)))
#f)
#f)
#f)
#f)
#f)
#f)
#f)
#f)
(void)
(error
'root-expand-context-decode-for-module
"bad encoding: ~s"
vec-s_0))
(let ((module-scopes_0 (extract-scope-list (vector-ref vec_0 0))))
(let ((post-expansion_0
(let ((app_0 (extract-scope (vector-ref vec_0 1))))
(cons
app_0
(let ((stx_0 (vector-ref vec_0 1)))
(begin-unsafe (syntax-mpi-shifts stx_0)))))))
(let ((top-level-bind-scope_0 (new-scope 'module)))
(let ((all-scopes-stx_0 (vector-ref vec_0 2)))
(let ((use-site-scopes_0
(box (extract-scope-list (vector-ref vec_0 3)))))
(let ((defined-syms_0
(unpack-defined-syms (vector-ref vec_0 4))))
(let ((frame-id_0 (syntax-e$1 (vector-ref vec_0 5))))
(let ((counter_0
(box (syntax-e$1 (vector-ref vec_0 6)))))
(let ((lift-key_0 (generate-lift-key)))
(let ((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))
(begin-unsafe
(root-expand-context/outer1.1
(root-expand-context/inner2.1
self_0
module-scopes_1
top-level-bind-scope_1
all-scopes-stx_1
defined-syms_1
counter_1
lift-key_0)
post-expansion_1
use-site-scopes_1
frame-id_1))))))))))))))))
(define defined-syms-hash?
(lambda (v_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 v_0 i_0))
(case-lambda
((phase_0 ht-s_0)
(let ((result_1
(let ((result_1
(if (phase? phase_0)
(if (hash? (syntax-e$1 ht-s_0))
(let ((ht_0 (syntax-e$1 ht-s_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (result_1 i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
ht_0
i_1))
(case-lambda
((sym_0 id_0)
(let ((result_2
(let ((result_2
(if (symbol?
sym_0)
(identifier?
id_0)
#f)))
(values
result_2))))
(if (if (not
(let ((x_0
(list
sym_0
id_0)))
(not
result_2)))
#t
#f)
(for-loop_1
result_2
(hash-iterate-next
ht_0
i_1))
result_2)))
(args
(raise-binding-result-arity-error
2
args))))
result_1))))))
(for-loop_1
#t
(hash-iterate-first ht_0)))))
#f)
#f)))
(values result_1))))
(if (if (not
(let ((x_0 (list phase_0 ht-s_0)))
(not result_1)))
#t
#f)
(for-loop_0 result_1 (hash-iterate-next v_0 i_0))
result_1)))
(args (raise-binding-result-arity-error 2 args))))
result_0))))))
(for-loop_0 #t (hash-iterate-first v_0))))))
(define extract-scope-list
(lambda (stx_0)
(map_1346 generalize-scope (set->list (syntax-scope-set stx_0 0)))))
(define syntax-with-one-scope?
(lambda (stx_0)
(if (syntax?$1 stx_0)
(=
1
(let ((s_0 (syntax-scope-set stx_0 0)))
(begin-unsafe (hash-count s_0))))
#f)))
(define extract-scope
(lambda (stx_0)
(let ((s_0 (syntax-scope-set stx_0 0)))
(generalize-scope (set-first s_0)))))
(define extract-shifts (lambda (stx_0) (syntax-mpi-shifts stx_0)))
(define unpack-defined-syms
(lambda (v_0)
(hash-copy
(let ((ht_0 (syntax-e$1 v_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((phase_0 ht-s_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(hash-copy
(let ((ht_1 (syntax-e$1 ht-s_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1 i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
ht_1
i_1))
(case-lambda
((sym_0 id_0)
(let ((table_2
(let ((table_2
(call-with-values
(lambda ()
(values
sym_0
id_0))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))))
(for-loop_1
table_2
(hash-iterate-next
ht_1
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
table_1))))))
(for-loop_1
hash2725
(hash-iterate-first ht_1))))))))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (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))))))))
(define 1/primitive-table primitive-table)
(define 1/primitive->compiled-position primitive->compiled-position)
(define 1/compiled-position->primitive compiled-position->primitive)
(define 1/primitive-in-category? primitive-in-category?)
(define 1/primitive-lookup primitive-lookup)
(define 1/linklet? linklet?)
(define 1/compile-linklet compile-linklet)
(define 1/recompile-linklet recompile-linklet)
(define 1/eval-linklet eval-linklet)
(define 1/instantiate-linklet instantiate-linklet)
(define 1/linklet-import-variables linklet-import-variables)
(define 1/linklet-export-variables linklet-export-variables)
(define 1/instance? instance?)
(define 1/make-instance make-instance)
(define 1/instance-name instance-name)
(define 1/instance-data instance-data)
(define 1/instance-variable-names instance-variable-names)
(define 1/instance-variable-value instance-variable-value)
(define 1/instance-set-variable-value! instance-set-variable-value!)
(define 1/instance-unset-variable! instance-unset-variable!)
(define 1/instance-describe-variable! instance-describe-variable!)
(define 1/linklet-virtual-machine-bytes linklet-virtual-machine-bytes)
(define 1/write-linklet-bundle-hash write-linklet-bundle-hash)
(define 1/read-linklet-bundle-hash read-linklet-bundle-hash)
(define 1/variable-reference? variable-reference?)
(define 1/variable-reference->instance variable-reference->instance)
(define 1/variable-reference-constant? variable-reference-constant?)
(define 1/variable-reference-from-unsafe? variable-reference-from-unsafe?)
(define effect_3049
(begin
(void
(if variable-reference-constant?
(void)
(error
"broken '#%linklet primitive table; maybe you need to use \"bootstrap-run.rkt\"")))
(void)))
(define struct:module-registry
(make-record-type-descriptor*
'module-registry
#f
(|#%nongenerative-uid| module-registry)
#f
#f
2
0))
(define effect_2643
(struct-type-install-properties!
struct:module-registry
'module-registry
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'module-registry))
(define module-registry1.1
(|#%name|
module-registry
(record-constructor
(make-record-constructor-descriptor struct:module-registry #f #f))))
(define module-registry?_2653
(|#%name| module-registry? (record-predicate struct:module-registry)))
(define module-registry?
(|#%name|
module-registry?
(lambda (v)
(if (module-registry?_2653 v)
#t
($value
(if (impersonator? v)
(module-registry?_2653 (impersonator-val v))
#f))))))
(define module-registry-declarations_3107
(|#%name|
module-registry-declarations
(record-accessor struct:module-registry 0)))
(define module-registry-declarations
(|#%name|
module-registry-declarations
(lambda (s)
(if (module-registry?_2653 s)
(module-registry-declarations_3107 s)
($value
(impersonate-ref
module-registry-declarations_3107
struct:module-registry
0
s
'module-registry
'declarations))))))
(define module-registry-lock-box_2205
(|#%name|
module-registry-lock-box
(record-accessor struct:module-registry 1)))
(define module-registry-lock-box
(|#%name|
module-registry-lock-box
(lambda (s)
(if (module-registry?_2653 s)
(module-registry-lock-box_2205 s)
($value
(impersonate-ref
module-registry-lock-box_2205
struct:module-registry
1
s
'module-registry
'lock-box))))))
(define make-module-registry
(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)))
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((v_0 (unbox lock-box_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0
or-part_0
(let ((app_0 (car v_0)))
(sync/timeout
0
app_0
(let ((or-part_1 (weak-box-value (cdr v_0))))
(if or-part_1 or-part_1 never-evt))))))
(let ((sema_0 (make-semaphore)))
(let ((lock_0
(let ((app_0 (semaphore-peek-evt sema_0)))
(cons app_0 (make-weak-box (current-thread))))))
(|#%app|
(dynamic-wind
void
(lambda ()
(if (unsafe-box*-cas! lock-box_0 v_0 lock_0)
(begin (|#%app| proc_0) void)
(lambda () (loop_0))))
(lambda () (semaphore-post sema_0))))))
(if (let ((app_0 (current-thread)))
(eq? app_0 (weak-box-value (cdr v_0))))
(|#%app| proc_0)
(begin
(let ((app_0 (car v_0)))
(sync
app_0
(let ((or-part_0 (weak-box-value (cdr v_0))))
(if or-part_0 or-part_0 never-evt))))
(loop_0))))))))))
(loop_0)))))
(define struct:namespace
(make-record-type-descriptor*
'namespace
#f
(|#%nongenerative-uid| namespace)
#f
#f
15
4096))
(define effect_2781
(struct-type-install-properties!
struct:namespace
'namespace
15
0
#f
(list
(cons prop:authentic #t)
(cons
prop:custom-write
(lambda (ns_0 port_0 mode_0)
(begin
(write-string "#<namespace" port_0)
(let ((n_0 (namespace-source-name ns_0)))
(begin
(if n_0
(fprintf port_0 ":~a" (|#%app| namespace->name ns_0))
(void))
(let ((0-phase_0 (namespace-0-phase ns_0)))
(let ((phase-level_0 (phase- (namespace-phase ns_0) 0-phase_0)))
(begin
(if (begin-unsafe (eq? phase-level_0 0))
(void)
(fprintf port_0 ":~s" phase-level_0))
(if (begin-unsafe (eq? 0-phase_0 0))
(void)
(fprintf
port_0
"~a~s"
(if (positive? 0-phase_0) "+" "")
0-phase_0))
(write-string ">" port_0))))))))))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9 10 11 13 14)
#f
'namespace))
(define namespace1.1
(|#%name|
namespace
(record-constructor
(make-record-constructor-descriptor struct:namespace #f #f))))
(define 1/namespace? (|#%name| namespace? (record-predicate struct:namespace)))
(define namespace-mpi
(|#%name| namespace-mpi (record-accessor struct:namespace 0)))
(define namespace-source-name
(|#%name| namespace-source-name (record-accessor struct:namespace 1)))
(define namespace-root-expand-ctx
(|#%name| namespace-root-expand-ctx (record-accessor struct:namespace 2)))
(define namespace-phase
(|#%name| namespace-phase (record-accessor struct:namespace 3)))
(define namespace-0-phase
(|#%name| namespace-0-phase (record-accessor struct:namespace 4)))
(define namespace-phase-to-namespace
(|#%name| namespace-phase-to-namespace (record-accessor struct:namespace 5)))
(define namespace-phase-level-to-definitions
(|#%name|
namespace-phase-level-to-definitions
(record-accessor struct:namespace 6)))
(define namespace-module-registry$1
(|#%name| namespace-module-registry (record-accessor struct:namespace 7)))
(define namespace-bulk-binding-registry
(|#%name|
namespace-bulk-binding-registry
(record-accessor struct:namespace 8)))
(define namespace-submodule-declarations
(|#%name|
namespace-submodule-declarations
(record-accessor struct:namespace 9)))
(define namespace-root-namespace
(|#%name| namespace-root-namespace (record-accessor struct:namespace 10)))
(define namespace-declaration-inspector
(|#%name|
namespace-declaration-inspector
(record-accessor struct:namespace 11)))
(define namespace-inspector
(|#%name| namespace-inspector (record-accessor struct:namespace 12)))
(define namespace-available-module-instances
(|#%name|
namespace-available-module-instances
(record-accessor struct:namespace 13)))
(define namespace-module-instances
(|#%name| namespace-module-instances (record-accessor struct:namespace 14)))
(define set-namespace-inspector!
(|#%name| set-namespace-inspector! (record-mutator struct:namespace 12)))
(define struct:definitions
(make-record-type-descriptor*
'definitions
#f
(|#%nongenerative-uid| definitions)
#f
#f
2
0))
(define effect_2279
(struct-type-install-properties!
struct:definitions
'definitions
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'definitions))
(define definitions2.1
(|#%name|
definitions
(record-constructor
(make-record-constructor-descriptor struct:definitions #f #f))))
(define definitions?
(|#%name| definitions? (record-predicate struct:definitions)))
(define definitions-variables
(|#%name| definitions-variables (record-accessor struct:definitions 0)))
(define definitions-transformers
(|#%name| definitions-transformers (record-accessor struct:definitions 1)))
(define make-namespace (lambda () (new-namespace.1 #t unsafe-undefined #f)))
(define new-namespace.1
(|#%name|
new-namespace
(lambda (register?4_0 root-expand-ctx3_0 share-from-ns7_0)
(begin
(let ((root-expand-ctx_0
(if (eq? root-expand-ctx3_0 unsafe-undefined)
(make-root-expand-context.1
#f
null
unsafe-undefined
unsafe-undefined
top-level-module-path-index)
root-expand-ctx3_0)))
(let ((phase_0
(if share-from-ns7_0 (namespace-phase share-from-ns7_0) 0)))
(let ((app_0 (box root-expand-ctx_0)))
(let ((ns_0
(let ((app_1 (make-small-hasheqv)))
(let ((app_2 (make-small-hasheqv)))
(let ((app_3
(if share-from-ns7_0
(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
(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
(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)
(lambda (v_0)
(begin
(if (1/namespace? v_0)
(void)
(raise-argument-error 'current-namespace "namespace?" v_0))
v_0))
'current-namespace))
(define namespace-get-root-expand-ctx
(lambda (ns_0) (force (unbox (namespace-root-expand-ctx ns_0)))))
(define namespace-set-root-expand-ctx!
(lambda (ns_0 root-ctx_0)
(set-box! (namespace-root-expand-ctx ns_0) root-ctx_0)))
(define namespace-self-mpi
(lambda (ns_0)
(let ((v_0 (namespace-get-root-expand-ctx ns_0)))
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner v_0))))))
(define namespace-self-mpi/no-top-level
(lambda (ns_0)
(let ((mpi_0
(let ((v_0 (namespace-get-root-expand-ctx ns_0)))
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner v_0))))))
(if (if mpi_0 (begin-unsafe (eq? top-level-module-path-index mpi_0)) #f)
#f
mpi_0))))
(define namespace->module
(lambda (ns_0 name_0)
(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 ((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)))
(let ((s_0
(if (not n_0)
'top-level
(if (symbol? n_0)
(format "'~s" n_0)
(string-append "\"" (path->string n_0) "\"")))))
(let ((r_0
(1/resolved-module-path-name
(1/module-path-index-resolve (namespace-mpi ns_0)))))
(if (pair? r_0)
(string-append
"(submod "
s_0
" "
(substring (format "~s" (cdr r_0)) 1))
s_0))))))
(define namespace->definitions
(lambda (ns_0 phase-level_0)
(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|
namespace-set-variable!
(lambda (ns10_0 phase-level11_0 name12_0 val13_0 as-constant?9_0)
(begin
(let ((d_0 (namespace->definitions ns10_0 phase-level11_0)))
(instance-set-variable-value!
(definitions-variables d_0)
name12_0
val13_0
(if as-constant?9_0 'constant #f))))))))
(case-lambda
((ns_0 phase-level_0 name_0 val_0)
(namespace-set-variable!_0 ns_0 phase-level_0 name_0 val_0 #f))
((ns_0 phase-level_0 name_0 val_0 as-constant?9_0)
(namespace-set-variable!_0
ns_0
phase-level_0
name_0
val_0
as-constant?9_0)))))
(define namespace-set-consistent!
(lambda (ns_0 phase-level_0 name_0 val_0)
(let ((d_0 (namespace->definitions ns_0 phase-level_0)))
(instance-set-variable-value!
(definitions-variables d_0)
name_0
val_0
'consistent))))
(define namespace-unset-variable!
(lambda (ns_0 phase-level_0 name_0)
(let ((d_0 (namespace->definitions ns_0 phase-level_0)))
(instance-unset-variable! (definitions-variables d_0) name_0))))
(define namespace-set-transformer!
(lambda (ns_0 phase-level_0 name_0 val_0)
(let ((d_0 (namespace->definitions ns_0 (add1 phase-level_0))))
(hash-set! (definitions-transformers d_0) name_0 val_0))))
(define namespace-unset-transformer!
(lambda (ns_0 phase-level_0 name_0)
(let ((d_0 (namespace->definitions ns_0 (add1 phase-level_0))))
(hash-remove! (definitions-transformers d_0) name_0))))
(define namespace-get-variable
(lambda (ns_0 phase-level_0 name_0 fail-k_0)
(let ((d_0 (namespace->definitions ns_0 phase-level_0)))
(instance-variable-value (definitions-variables d_0) name_0 fail-k_0))))
(define namespace-get-transformer
(lambda (ns_0 phase-level_0 name_0 fail-k_0)
(let ((d_0 (namespace->definitions ns_0 (add1 phase-level_0))))
(hash-ref (definitions-transformers d_0) name_0 fail-k_0))))
(define namespace->instance
(lambda (ns_0 phase-shift_0)
(definitions-variables (namespace->definitions ns_0 phase-shift_0))))
(define namespace-same-instance?
(lambda (a-ns_0 b-ns_0)
(let ((app_0
(let ((small-ht_0 (namespace-phase-level-to-definitions a-ns_0)))
(begin-unsafe (hash-ref (unbox small-ht_0) 0 'no-a)))))
(eq?
app_0
(let ((small-ht_0 (namespace-phase-level-to-definitions b-ns_0)))
(begin-unsafe (hash-ref (unbox small-ht_0) 0 'no-b)))))))
(define original-property-sym (gensym 'original))
(define syntax->list$1
(|#%name|
syntax->list
(lambda (s_0)
(begin
(let ((l_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(if (pair? s_1)
(let ((app_0 (car s_1)))
(cons app_0 (loop_0 (cdr s_1))))
(if (syntax?$1 s_1)
(loop_0 (syntax-e$1 s_1))
s_1)))))))
(loop_0 s_0))))
(if (list? l_0) l_0 #f))))))
(define missing$1 (gensym))
(define syntax-track-origin$1
(let ((syntax-track-origin_0
(|#%name|
syntax-track-origin
(lambda (new-stx2_0 old-stx3_0 id1_0)
(begin
(let ((id_0
(if (eq? id1_0 unsafe-undefined)
(if (identifier? old-stx3_0)
old-stx3_0
(let ((v_0 (syntax-e/no-taint old-stx3_0)))
(if (pair? v_0) (car v_0) #f)))
id1_0)))
(let ((old-props_0 (syntax-props old-stx3_0)))
(if (zero? (hash-count old-props_0))
(if id_0
(syntax-property$1
new-stx2_0
'origin
(cons
id_0
(hash-ref (syntax-props new-stx2_0) 'origin null)))
new-stx2_0)
(let ((new-props_0 (syntax-props new-stx2_0)))
(if (zero? (hash-count new-props_0))
(if id_0
(let ((old-origin_0
(plain-property-value
(hash-ref old-props_0 'origin missing$1))))
(let ((origin_0
(if (eq? old-origin_0 missing$1)
(list id_0)
(cons id_0 old-origin_0))))
(if (syntax?$1 new-stx2_0)
(let ((props4_0
(hash-set
old-props_0
'origin
origin_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)
(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?"
new-stx2_0)))
(let ((old-props-with-origin_0
(if id_0
(hash-set
old-props_0
'origin
(cons
id_0
(hash-ref old-props_0 'origin null)))
old-props_0)))
(let ((updated-props_0
(if (let ((app_0
(hash-count
old-props-with-origin_0)))
(< app_0 (hash-count new-props_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (new-props_1 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
old-props-with-origin_0
i_0))
(case-lambda
((k_0 v_0)
(let ((new-props_2
(let ((new-props_2
(let ((new-v_0
(hash-ref
new-props_1
k_0
missing$1)))
(hash-set
new-props_1
k_0
(if (eq?
new-v_0
missing$1)
v_0
(cons/preserve
new-v_0
v_0))))))
(values
new-props_2))))
(for-loop_0
new-props_2
(unsafe-immutable-hash-iterate-next
old-props-with-origin_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
new-props_1))))))
(for-loop_0
new-props_0
(unsafe-immutable-hash-iterate-first
old-props-with-origin_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (old-props_1 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(unsafe-immutable-hash-iterate-key+value
new-props_0
i_0))
(case-lambda
((k_0 v_0)
(let ((old-props_2
(let ((old-props_2
(let ((old-v_0
(hash-ref
old-props_1
k_0
missing$1)))
(hash-set
old-props_1
k_0
(if (eq?
old-v_0
missing$1)
v_0
(cons/preserve
v_0
old-v_0))))))
(values
old-props_2))))
(for-loop_0
old-props_2
(unsafe-immutable-hash-iterate-next
new-props_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
old-props_1))))))
(for-loop_0
old-props-with-origin_0
(unsafe-immutable-hash-iterate-first
new-props_0)))))))
(if (syntax?$1 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?"
new-stx2_0))))))))))))))
(|#%name|
syntax-track-origin
(case-lambda
((new-stx_0 old-stx_0)
(begin (syntax-track-origin_0 new-stx_0 old-stx_0 unsafe-undefined)))
((new-stx_0 old-stx_0 id1_0)
(syntax-track-origin_0 new-stx_0 old-stx_0 id1_0))))))
(define cons/preserve
(lambda (a_0 b_0)
(if (let ((or-part_0 (preserved-property-value? a_0)))
(if or-part_0 or-part_0 (preserved-property-value? b_0)))
(preserved-property-value1.1
(let ((app_0 (plain-property-value a_0)))
(cons app_0 (plain-property-value b_0))))
(cons a_0 b_0))))
(define syntax-track-origin*
(lambda (old-stxes_0 new-stx_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (new-stx_1 lst_0)
(begin
(if (pair? lst_0)
(let ((old-stx_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((new-stx_2
(let ((new-stx_2
(syntax-track-origin$1 new-stx_1 old-stx_0)))
(values new-stx_2))))
(for-loop_0 new-stx_2 rest_0))))
new-stx_1))))))
(for-loop_0 new-stx_0 old-stxes_0)))))
(define struct:syntax-binding-set
(make-record-type-descriptor*
'syntax-binding-set
#f
(|#%nongenerative-uid| syntax-binding-set)
#f
#f
1
0))
(define effect_2741
(struct-type-install-properties!
struct:syntax-binding-set
'syntax-binding-set
1
0
#f
null
(current-inspector)
#f
'(0)
#f
'syntax-binding-set))
(define syntax-binding-set1.1
(|#%name|
syntax-binding-set
(record-constructor
(make-record-constructor-descriptor struct:syntax-binding-set #f #f))))
(define 1/syntax-binding-set?_3050
(|#%name| syntax-binding-set? (record-predicate struct:syntax-binding-set)))
(define 1/syntax-binding-set?
(|#%name|
syntax-binding-set?
(lambda (v)
(if (1/syntax-binding-set?_3050 v)
#t
($value
(if (impersonator? v)
(1/syntax-binding-set?_3050 (impersonator-val v))
#f))))))
(define syntax-binding-set-binds_2873
(|#%name|
syntax-binding-set-binds
(record-accessor struct:syntax-binding-set 0)))
(define syntax-binding-set-binds
(|#%name|
syntax-binding-set-binds
(lambda (s)
(if (1/syntax-binding-set?_3050 s)
(syntax-binding-set-binds_2873 s)
($value
(impersonate-ref
syntax-binding-set-binds_2873
struct:syntax-binding-set
0
s
'syntax-binding-set
'binds))))))
(define struct:bind
(make-record-type-descriptor*
'bind
#f
(|#%nongenerative-uid| bind)
#f
#f
3
0))
(define effect_3043
(struct-type-install-properties!
struct:bind
'bind
3
0
#f
null
(current-inspector)
#f
'(0 1 2)
#f
'bind))
(define bind2.1
(|#%name|
bind
(record-constructor
(make-record-constructor-descriptor struct:bind #f #f))))
(define bind?_2465 (|#%name| bind? (record-predicate struct:bind)))
(define bind?
(|#%name|
bind?
(lambda (v)
(if (bind?_2465 v)
#t
($value (if (impersonator? v) (bind?_2465 (impersonator-val v)) #f))))))
(define bind-sym_2139 (|#%name| bind-sym (record-accessor struct:bind 0)))
(define bind-sym
(|#%name|
bind-sym
(lambda (s)
(if (bind?_2465 s)
(bind-sym_2139 s)
($value (impersonate-ref bind-sym_2139 struct:bind 0 s 'bind 'sym))))))
(define bind-phase_2605 (|#%name| bind-phase (record-accessor struct:bind 1)))
(define bind-phase
(|#%name|
bind-phase
(lambda (s)
(if (bind?_2465 s)
(bind-phase_2605 s)
($value
(impersonate-ref bind-phase_2605 struct:bind 1 s 'bind 'phase))))))
(define bind-binding_2667
(|#%name| bind-binding (record-accessor struct:bind 2)))
(define bind-binding
(|#%name|
bind-binding
(lambda (s)
(if (bind?_2465 s)
(bind-binding_2667 s)
($value
(impersonate-ref bind-binding_2667 struct:bind 2 s 'bind 'binding))))))
(define syntax-binding-set-extend$1
(|#%name|
syntax-binding-set-extend
(lambda (bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym_0
nominal-require-phase_0
inspector_0)
(begin
(if (1/syntax-binding-set? bs_0)
(let ((binds5_0
(let ((app_0
(bind2.1
as-sym_0
as-phase_0
(make-module-binding.1
inspector_0
null
#f
#f
nominal-mpi_0
nominal-phase_0
nominal-require-phase_0
nominal-sym_0
mpi_0
phase_0
sym_0))))
(cons app_0 (syntax-binding-set-binds bs_0)))))
(syntax-binding-set1.1 binds5_0))
(raise-argument-error 'struct-copy "syntax-binding-set?" bs_0))))))
(define syntax-binding-set->syntax$1
(|#%name|
syntax-binding-set->syntax
(lambda (bs_0 datum_0)
(begin
(let ((s_0
(let ((app_0 (datum->syntax$1 #f datum_0)))
(add-scope app_0 (new-multi-scope 'binding-set)))))
(begin
(let ((lst_0 (syntax-binding-set-binds bs_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((bind_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(let ((temp14_0
(syntax-scope-set
s_0
(bind-phase bind_0))))
(let ((temp15_0 (bind-sym bind_0)))
(let ((temp16_0 (bind-binding bind_0)))
(let ((temp15_1 temp15_0)
(temp14_1 temp14_0))
(add-binding-in-scopes!.1
#f
temp14_1
temp15_1
temp16_0)))))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)
s_0))))))
(define-values
(1/struct:exn:fail:syntax
make-exn:fail:syntax$1
1/exn:fail:syntax?
1/exn:fail:syntax-exprs)
(call-with-values
(lambda ()
(make-struct-type
'exn:fail:syntax
struct:exn:fail
1
0
#f
(list
(cons
prop:exn:srclocs
(lambda (e_0)
(filter
values
(map_1346
syntax-srcloc
(|#%app|
(check-not-unsafe-undefined
1/exn:fail:syntax-exprs
'1/exn:fail:syntax-exprs)
e_0))))))
#f
#f
'(0)
(lambda (str_0 cm_0 exprs_0 info_0)
(begin
(if (if (list? exprs_0) (andmap_2344 syntax?$1 exprs_0) #f)
(void)
(raise-argument-error 'exn:fail:syntax "(listof syntax?)" exprs_0))
(values str_0 cm_0 exprs_0)))
'exn:fail:syntax))
(case-lambda
((struct:_0 make-_0 ?_0 -ref_0 -set!_0)
(values
struct:_0
make-_0
?_0
(make-struct-field-accessor -ref_0 0 'exprs)))
(args (raise-binding-result-arity-error 5 args)))))
(define-values
(1/struct:exn:fail:syntax:unbound
make-exn:fail:syntax:unbound$1
1/exn:fail:syntax:unbound?)
(call-with-values
(lambda ()
(make-struct-type
'exn:fail:syntax:unbound
1/struct:exn:fail:syntax
0
0
#f
null
#f
#f
'()
#f
'exn:fail:syntax:unbound))
(case-lambda
((struct:_0 make-_0 ?_0 -ref_0 -set!_0) (values struct:_0 make-_0 ?_0))
(args (raise-binding-result-arity-error 5 args)))))
(define raise-syntax-error$1
(let ((raise-syntax-error_0
(|#%name|
raise-syntax-error
(lambda (given-name5_0
message6_0
expr1_0
sub-expr2_0
extra-sources3_0
message-suffix4_0)
(begin
(do-raise-syntax-error
'raise-syntax-error
make-exn:fail:syntax$1
given-name5_0
message6_0
expr1_0
sub-expr2_0
extra-sources3_0
message-suffix4_0))))))
(|#%name|
raise-syntax-error
(case-lambda
((given-name_0 message_0)
(begin (raise-syntax-error_0 given-name_0 message_0 #f #f null "")))
((given-name_0
message_0
expr_0
sub-expr_0
extra-sources_0
message-suffix4_0)
(raise-syntax-error_0
given-name_0
message_0
expr_0
sub-expr_0
extra-sources_0
message-suffix4_0))
((given-name_0 message_0 expr_0 sub-expr_0 extra-sources3_0)
(raise-syntax-error_0
given-name_0
message_0
expr_0
sub-expr_0
extra-sources3_0
""))
((given-name_0 message_0 expr_0 sub-expr2_0)
(raise-syntax-error_0
given-name_0
message_0
expr_0
sub-expr2_0
null
""))
((given-name_0 message_0 expr1_0)
(raise-syntax-error_0 given-name_0 message_0 expr1_0 #f null ""))))))
(define raise-unbound-syntax-error
(let ((raise-unbound-syntax-error_0
(|#%name|
raise-unbound-syntax-error
(lambda (given-name11_0
message12_0
expr7_0
sub-expr8_0
extra-sources9_0
message-suffix10_0)
(begin
(do-raise-syntax-error
'raise-unbound-syntax-error
make-exn:fail:syntax:unbound$1
given-name11_0
message12_0
expr7_0
sub-expr8_0
extra-sources9_0
message-suffix10_0))))))
(case-lambda
((given-name_0 message_0)
(raise-unbound-syntax-error_0 given-name_0 message_0 #f #f null ""))
((given-name_0
message_0
expr_0
sub-expr_0
extra-sources_0
message-suffix10_0)
(raise-unbound-syntax-error_0
given-name_0
message_0
expr_0
sub-expr_0
extra-sources_0
message-suffix10_0))
((given-name_0 message_0 expr_0 sub-expr_0 extra-sources9_0)
(raise-unbound-syntax-error_0
given-name_0
message_0
expr_0
sub-expr_0
extra-sources9_0
""))
((given-name_0 message_0 expr_0 sub-expr8_0)
(raise-unbound-syntax-error_0
given-name_0
message_0
expr_0
sub-expr8_0
null
""))
((given-name_0 message_0 expr7_0)
(raise-unbound-syntax-error_0
given-name_0
message_0
expr7_0
#f
null
"")))))
(define do-raise-syntax-error
(lambda (who_0
exn:fail:syntax_0
given-name_0
message_0
expr_0
sub-expr_0
extra-sources_0
message-suffix_0)
(begin
(if (let ((or-part_0 (not given-name_0)))
(if or-part_0 or-part_0 (symbol? given-name_0)))
(void)
(raise-argument-error who_0 "(or/c symbol? #f)" given-name_0))
(begin
(if (string? message_0)
(void)
(raise-argument-error who_0 "string?" message_0))
(begin
(if (if (list? extra-sources_0)
(andmap_2344 syntax?$1 extra-sources_0)
#f)
(void)
(raise-argument-error who_0 "(listof syntax?)" extra-sources_0))
(begin
(if (string? message-suffix_0)
(void)
(raise-argument-error who_0 "string?" message-suffix_0))
(let ((name_0
(format
"~a"
(if given-name_0
given-name_0
(let ((or-part_0 (extract-form-name expr_0)))
(if or-part_0 or-part_0 '?))))))
(let ((unbound-message_0
(let ((ids_0 (|#%app| current-previously-unbound)))
(let ((or-part_0
(if (pair? ids_0)
(let ((app_0 (if (null? (cdr ids_0)) "" "s")))
(format
"\n after encountering unbound identifier~a (which is possibly the real problem):~a"
app_0
(apply
string-append
(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
(format
"\n ~s"
(syntax-e$1
id_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)))))))
#f)))
(if or-part_0 or-part_0 "")))))
(let ((at-message_0
(let ((or-part_0
(if sub-expr_0
(if (error-print-source-location)
(format
"\n at: ~.s"
(syntax->datum$1
(datum->syntax$1 #f sub-expr_0)))
#f)
#f)))
(if or-part_0 or-part_0 ""))))
(let ((in-message_0
(let ((or-part_0
(if expr_0
(if (error-print-source-location)
(format
"\n in: ~.s"
(syntax->datum$1
(datum->syntax$1 #f expr_0)))
#f)
#f)))
(if or-part_0 or-part_0 ""))))
(let ((src-loc-str_0
(let ((or-part_0
(if (error-print-source-location)
(let ((or-part_0
(extract-source-location
sub-expr_0)))
(if or-part_0
or-part_0
(extract-source-location expr_0)))
#f)))
(if or-part_0 or-part_0 ""))))
(raise
(let ((app_0
(string-append
src-loc-str_0
name_0
": "
message_0
unbound-message_0
at-message_0
in-message_0
message-suffix_0)))
(let ((app_1 (current-continuation-marks)))
(|#%app|
exn:fail:syntax_0
app_0
app_1
(map_1346
syntax-taint$1
(if (if sub-expr_0 sub-expr_0 expr_0)
(cons
(datum->syntax$1
#f
(if sub-expr_0 sub-expr_0 expr_0))
extra-sources_0)
extra-sources_0)))))))))))))))))
(define extract-form-name
(lambda (s_0)
(if (syntax?$1 s_0)
(let ((e_0 (syntax-e$1 s_0)))
(if (symbol? e_0)
e_0
(if (if (pair? e_0) (identifier? (car e_0)) #f)
(syntax-e$1 (car e_0))
#f)))
#f)))
(define extract-source-location
(lambda (s_0)
(if (syntax?$1 s_0)
(if (syntax-srcloc s_0)
(let ((str_0 (srcloc->string (syntax-srcloc s_0))))
(if str_0 (string-append str_0 ": ") #f))
#f)
#f)))
(define current-previously-unbound (lambda () #f))
(define set-current-previously-unbound!
(lambda (proc_0) (set! current-previously-unbound proc_0)))
(define struct:module-use
(make-record-type-descriptor*
'module-use
#f
(|#%nongenerative-uid| module-use)
#f
#f
2
0))
(define effect_2861
(struct-type-install-properties!
struct:module-use
'module-use
2
0
#f
(list
(cons
prop:equal+hash
(list
(lambda (a_0 b_0 eql?_0)
(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)))
(call-with-values
(lambda () (1/module-path-index-split a-mod_0))
(case-lambda
((a-path_0 a-base_0)
(call-with-values
(lambda () (1/module-path-index-split b-mod_0))
(case-lambda
((b-path_0 b-base_0)
(let ((a-path_1 a-path_0) (a-base_1 a-base_0))
(if a-path_1
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)))))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
#f)
#f))))
(lambda (a_0 hash-code_0)
(let ((app_0 (|#%app| hash-code_0 (module-use-module a_0))))
(+ app_0 (|#%app| hash-code_0 (module-use-phase a_0)))))
(lambda (a_0 hash-code_0)
(let ((app_0 (|#%app| hash-code_0 (module-use-module a_0))))
(+ app_0 (|#%app| hash-code_0 (module-use-phase a_0))))))))
(current-inspector)
#f
'(0 1)
#f
'module-use))
(define module-use1.1
(|#%name|
module-use
(record-constructor
(make-record-constructor-descriptor struct:module-use #f #f))))
(define module-use?_2982
(|#%name| module-use? (record-predicate struct:module-use)))
(define module-use?
(|#%name|
module-use?
(lambda (v)
(if (module-use?_2982 v)
#t
($value
(if (impersonator? v) (module-use?_2982 (impersonator-val v)) #f))))))
(define module-use-module_2384
(|#%name| module-use-module (record-accessor struct:module-use 0)))
(define module-use-module
(|#%name|
module-use-module
(lambda (s)
(if (module-use?_2982 s)
(module-use-module_2384 s)
($value
(impersonate-ref
module-use-module_2384
struct:module-use
0
s
'module-use
'module))))))
(define module-use-phase_2668
(|#%name| module-use-phase (record-accessor struct:module-use 1)))
(define module-use-phase
(|#%name|
module-use-phase
(lambda (s)
(if (module-use?_2982 s)
(module-use-phase_2668 s)
($value
(impersonate-ref
module-use-phase_2668
struct:module-use
1
s
'module-use
'phase))))))
(define struct:module
(make-record-type-descriptor*
'module
#f
(|#%nongenerative-uid| module)
#f
#f
20
16))
(define effect_2359
(struct-type-install-properties!
struct:module
'module
20
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
#f
'module))
(define module1.1
(|#%name|
module
(record-constructor
(make-record-constructor-descriptor struct:module #f #f))))
(define module? (|#%name| module? (record-predicate struct:module)))
(define module-source-name
(|#%name| module-source-name (record-accessor struct:module 0)))
(define module-self (|#%name| module-self (record-accessor struct:module 1)))
(define module-requires
(|#%name| module-requires (record-accessor struct:module 2)))
(define module-provides
(|#%name| module-provides (record-accessor struct:module 3)))
(define module-access
(|#%name| module-access (record-accessor struct:module 4)))
(define module-language-info
(|#%name| module-language-info (record-accessor struct:module 5)))
(define module-min-phase-level
(|#%name| module-min-phase-level (record-accessor struct:module 6)))
(define module-max-phase-level
(|#%name| module-max-phase-level (record-accessor struct:module 7)))
(define module-phase-level-linklet-info-callback
(|#%name|
module-phase-level-linklet-info-callback
(record-accessor struct:module 8)))
(define module-force-bulk-binding
(|#%name| module-force-bulk-binding (record-accessor struct:module 9)))
(define module-prepare-instance
(|#%name| module-prepare-instance (record-accessor struct:module 10)))
(define module-instantiate-phase
(|#%name| module-instantiate-phase (record-accessor struct:module 11)))
(define module-primitive?
(|#%name| module-primitive? (record-accessor struct:module 12)))
(define module-is-predefined?
(|#%name| module-is-predefined? (record-accessor struct:module 13)))
(define module-cross-phase-persistent?
(|#%name| module-cross-phase-persistent? (record-accessor struct:module 14)))
(define module-no-protected?
(|#%name| module-no-protected? (record-accessor struct:module 15)))
(define module-inspector
(|#%name| module-inspector (record-accessor struct:module 16)))
(define module-submodule-names
(|#%name| module-submodule-names (record-accessor struct:module 17)))
(define module-supermodule-name
(|#%name| module-supermodule-name (record-accessor struct:module 18)))
(define module-get-all-variables
(|#%name| module-get-all-variables (record-accessor struct:module 19)))
(define set-module-access!
(|#%name| set-module-access! (record-mutator struct:module 4)))
(define struct:module-linklet-info
(make-record-type-descriptor*
'module-linklet-info
#f
(|#%nongenerative-uid| module-linklet-info)
#f
#f
6
0))
(define effect_2516
(struct-type-install-properties!
struct:module-linklet-info
'module-linklet-info
6
0
#f
(list (cons prop:authentic #t))
#f
#f
'(0 1 2 3 4 5)
#f
'module-linklet-info))
(define module-linklet-info2.1
(|#%name|
module-linklet-info
(record-constructor
(make-record-constructor-descriptor struct:module-linklet-info #f #f))))
(define module-linklet-info?
(|#%name|
module-linklet-info?
(record-predicate struct:module-linklet-info)))
(define module-linklet-info-linklet-or-instance
(|#%name|
module-linklet-info-linklet-or-instance
(record-accessor struct:module-linklet-info 0)))
(define module-linklet-info-module-uses
(|#%name|
module-linklet-info-module-uses
(record-accessor struct:module-linklet-info 1)))
(define module-linklet-info-self
(|#%name|
module-linklet-info-self
(record-accessor struct:module-linklet-info 2)))
(define module-linklet-info-inspector
(|#%name|
module-linklet-info-inspector
(record-accessor struct:module-linklet-info 3)))
(define module-linklet-info-extra-inspector
(|#%name|
module-linklet-info-extra-inspector
(record-accessor struct:module-linklet-info 4)))
(define module-linklet-info-extra-inspectorsss
(|#%name|
module-linklet-info-extra-inspectorsss
(record-accessor struct:module-linklet-info 5)))
(define make-module.1
(|#%name|
make-module
(lambda (cross-phase-persistent?16_0
force-bulk-binding-callback10_0
get-all-variables20_0
instantiate-phase-callback9_0
language-info13_0
max-phase-level8_0
min-phase-level7_0
no-protected?17_0
phase-level-linklet-info-callback12_0
predefined?15_0
prepare-instance-callback11_0
primitive?14_0
provides6_0
requires5_0
self4_0
source-name3_0
submodule-names18_0
supermodule-name19_0)
(begin
(let ((phase-level-linklet-info-callback_0
(if (eq? phase-level-linklet-info-callback12_0 unsafe-undefined)
(|#%name|
phase-level-linklet-info-callback
(lambda (phase-level_0 ns_0 insp_0) (begin #f)))
phase-level-linklet-info-callback12_0)))
(let ((cross-phase-persistent?_0
(if (eq? cross-phase-persistent?16_0 unsafe-undefined)
primitive?14_0
cross-phase-persistent?16_0)))
(let ((get-all-variables_0
(if (eq? get-all-variables20_0 unsafe-undefined)
(|#%name| get-all-variables (lambda () (begin null)))
get-all-variables20_0)))
(let ((app_0 (unresolve-requires requires5_0)))
(module1.1
source-name3_0
self4_0
app_0
provides6_0
#f
language-info13_0
min-phase-level7_0
max-phase-level8_0
phase-level-linklet-info-callback_0
force-bulk-binding-callback10_0
prepare-instance-callback11_0
instantiate-phase-callback9_0
primitive?14_0
predefined?15_0
cross-phase-persistent?_0
no-protected?17_0
(current-code-inspector)
submodule-names18_0
supermodule-name19_0
get-all-variables_0)))))))))
(define struct:module-instance
(make-record-type-descriptor*
'module-instance
#f
(|#%nongenerative-uid| module-instance)
#f
#f
7
52))
(define effect_2597
(struct-type-install-properties!
struct:module-instance
'module-instance
7
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 3 6)
#f
'module-instance))
(define module-instance40.1
(|#%name|
module-instance
(record-constructor
(make-record-constructor-descriptor struct:module-instance #f #f))))
(define module-instance?
(|#%name| module-instance? (record-predicate struct:module-instance)))
(define module-instance-namespace
(|#%name|
module-instance-namespace
(record-accessor struct:module-instance 0)))
(define module-instance-module
(|#%name| module-instance-module (record-accessor struct:module-instance 1)))
(define module-instance-shifted-requires
(|#%name|
module-instance-shifted-requires
(record-accessor struct:module-instance 2)))
(define module-instance-phase-level-to-state
(|#%name|
module-instance-phase-level-to-state
(record-accessor struct:module-instance 3)))
(define module-instance-made-available?
(|#%name|
module-instance-made-available?
(record-accessor struct:module-instance 4)))
(define module-instance-attached?
(|#%name|
module-instance-attached?
(record-accessor struct:module-instance 5)))
(define module-instance-data-box
(|#%name|
module-instance-data-box
(record-accessor struct:module-instance 6)))
(define set-module-instance-shifted-requires!
(|#%name|
set-module-instance-shifted-requires!
(record-mutator struct:module-instance 2)))
(define set-module-instance-made-available?!
(|#%name|
set-module-instance-made-available?!
(record-mutator struct:module-instance 4)))
(define set-module-instance-attached?!
(|#%name|
set-module-instance-attached?!
(record-mutator struct:module-instance 5)))
(define make-module-instance
(lambda (m-ns_0 m_0)
(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
(lambda (for-submodule?43_0 mpi41_0 root-expand-context42_0 ns47_0)
(begin
(let ((name_0 (1/module-path-index-resolve mpi41_0)))
(let ((m-ns_0
(let ((the-struct_0
(new-namespace.1 #f root-expand-context42_0 ns47_0)))
(if (1/namespace? the-struct_0)
(let ((source-name131_0
(resolved-module-path-root-name name_0)))
(let ((submodule-declarations134_0
(if for-submodule?43_0
(namespace-submodule-declarations ns47_0)
(make-small-hasheq))))
(let ((available-module-instances135_0 (make-hasheqv)))
(let ((module-instances136_0 (make-hasheqv)))
(let ((declaration-inspector137_0
(current-code-inspector)))
(let ((module-instances136_1
module-instances136_0)
(available-module-instances135_1
available-module-instances135_0)
(submodule-declarations134_1
submodule-declarations134_0)
(source-name131_1 source-name131_0))
(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?"
the-struct_0)))))
(begin
(let ((small-ht_0 (namespace-phase-to-namespace m-ns_0)))
(begin-unsafe
(set-box! small-ht_0 (hash-set (unbox small-ht_0) 0 m-ns_0))))
(let ((at-phase_0 (make-hasheq)))
(begin
(hash-set! (namespace-module-instances m-ns_0) 0 at-phase_0)
(hash-set! at-phase_0 name_0 (make-module-instance m-ns_0 #f))
m-ns_0)))))))))
(define declare-module!.1
(|#%name|
declare-module!
(lambda (with-submodules?49_0 ns51_0 m52_0 mod-name53_0)
(begin
(let ((prior-m_0
(if with-submodules?49_0
(hash-ref
(module-registry-declarations
(namespace-module-registry$1 ns51_0))
mod-name53_0
#f)
#f)))
(let ((prior-mi_0
(if prior-m_0
(if (not (eq? m52_0 prior-m_0))
(let ((temp143_0 (namespace-phase ns51_0)))
(namespace->module-instance.1
#f
#f
void
ns51_0
mod-name53_0
temp143_0))
#f)
#f)))
(begin
(if (if prior-m_0 (not (eq? m52_0 prior-m_0)) #f)
(check-redeclaration-ok prior-m_0 prior-mi_0 mod-name53_0)
(void))
(if with-submodules?49_0
(hash-set!
(module-registry-declarations
(namespace-module-registry$1 ns51_0))
mod-name53_0
m52_0)
(let ((small-ht_0 (namespace-submodule-declarations ns51_0)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set (unbox small-ht_0) mod-name53_0 m52_0)))))
(if with-submodules?49_0
(begin
(let ((bulk-binding-registry_0
(namespace-bulk-binding-registry ns51_0)))
(let ((self_0 (module-self m52_0)))
(let ((provides_0 (module-provides m52_0)))
(begin-unsafe
(let ((app_0
(bulk-binding-registry-table
bulk-binding-registry_0)))
(hash-set!
app_0
mod-name53_0
(bulk-provide13.1 self_0 provides_0)))))))
(|#%app|
(|#%app| 1/current-module-name-resolver)
mod-name53_0
#f))
(void))
(if prior-mi_0
(let ((m-ns_0 (module-instance-namespace prior-mi_0)))
(let ((states_0
(module-instance-phase-level-to-state prior-mi_0)))
(let ((phase_0 (namespace-phase ns51_0)))
(let ((visit?_0
(eq?
'started
(let ((key_0 (add1 phase_0)))
(begin-unsafe
(hash-ref (unbox states_0) key_0 #f))))))
(let ((run?_0
(eq?
'started
(begin-unsafe
(hash-ref (unbox states_0) phase_0 #f)))))
(let ((at-phase_0
(hash-ref
(namespace-module-instances ns51_0)
phase_0)))
(begin
(hash-set!
at-phase_0
mod-name53_0
(make-module-instance m-ns_0 m52_0))
(set-module-instance-shifted-requires!
prior-mi_0
#f)
(if visit?_0
(let ((temp145_0 (namespace-mpi m-ns_0)))
(namespace-module-visit!.1
unsafe-undefined
ns51_0
temp145_0
phase_0))
(void))
(if run?_0
(let ((temp148_0 (namespace-mpi m-ns_0)))
(namespace-module-instantiate!.1
#t
unsafe-undefined
hash2610
null
#f
ns51_0
temp148_0
phase_0))
(void)))))))))
(void)))))))))
(define check-redeclaration-ok
(lambda (prior-m_0 prior-mi_0 mod-name_0)
(begin
(if (module-cross-phase-persistent? prior-m_0)
(raise-arguments-error
'module
"cannot redeclare cross-phase persistent module"
"module name"
(module-name->error-string mod-name_0))
(void))
(if (if prior-mi_0
(let ((or-part_0 (module-instance-attached? prior-mi_0)))
(if or-part_0
or-part_0
(not
(let ((app_0 (current-code-inspector)))
(inspector-superior?
app_0
(namespace-inspector
(module-instance-namespace prior-mi_0)))))))
#f)
(raise-arguments-error
'module
"current code inspector cannot redeclare module"
"module name"
(module-name->error-string mod-name_0))
(void)))))
(define raise-unknown-module-error
(lambda (who_0 mod-name_0)
(raise-arguments-error
who_0
"unknown module"
"module name"
(module-name->error-string mod-name_0))))
(define namespace->module-linklet-info
(lambda (ns_0 name_0 phase-level_0)
(let ((m_0 (namespace->module ns_0 name_0)))
(if 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))))
(define namespace->module-instance.1
(|#%name|
namespace->module-instance
(lambda (check-available-at-phase-level56_0
complain-on-failure?55_0
unavailable-callback57_0
ns61_0
name62_0
0-phase63_0)
(begin
(let ((mi_0
(let ((or-part_0
(hash-ref
(hash-ref
(namespace-module-instances ns61_0)
0-phase63_0
hash2610)
name62_0
#f)))
(if or-part_0
or-part_0
(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
check-available-at-phase-level56_0
unavailable-callback57_0)
mi_0))))))
(define namespace-install-module-namespace!
(lambda (ns_0 name_0 0-phase_0 m_0 existing-m-ns_0)
(let ((m-ns_0
(if (1/namespace? ns_0)
(let ((mpi150_0 (namespace-mpi existing-m-ns_0)))
(let ((source-name151_0
(namespace-source-name existing-m-ns_0)))
(let ((root-expand-ctx152_0
(box
(unbox (namespace-root-expand-ctx existing-m-ns_0)))))
(let ((phase153_0 (namespace-phase existing-m-ns_0)))
(let ((0-phase154_0 (namespace-0-phase existing-m-ns_0)))
(let ((phase-to-namespace155_0 (make-small-hasheqv)))
(let ((phase-level-to-definitions156_0
(if (module-cross-phase-persistent? m_0)
(namespace-phase-level-to-definitions
existing-m-ns_0)
(make-small-hasheqv))))
(let ((declaration-inspector157_0
(module-inspector m_0)))
(let ((inspector158_0
(namespace-inspector existing-m-ns_0)))
(let ((declaration-inspector157_1
declaration-inspector157_0)
(phase-level-to-definitions156_1
phase-level-to-definitions156_0)
(phase-to-namespace155_1
phase-to-namespace155_0)
(0-phase154_1 0-phase154_0)
(phase153_1 phase153_0)
(root-expand-ctx152_1
root-expand-ctx152_0)
(source-name151_1 source-name151_0)
(mpi150_1 mpi150_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
(set-module-instance-attached?! mi_0 #t)
(if (module-cross-phase-persistent? m_0)
(begin
(let ((small-ht_0 (namespace-phase-to-namespace m-ns_0)))
(begin-unsafe
(set-box! small-ht_0 (hash-set (unbox small-ht_0) 0 m-ns_0))))
(let ((small-ht_0 (namespace-phase-level-to-definitions m-ns_0)))
(let ((val_0 (namespace->definitions existing-m-ns_0 0)))
(let ((small-ht_1 small-ht_0))
(begin-unsafe
(set-box!
small-ht_1
(hash-set (unbox small-ht_1) 0 val_0))))))
(let ((small-ht_0 (namespace-phase-to-namespace m-ns_0)))
(let ((val_0 (namespace->namespace-at-phase m-ns_0 1)))
(let ((small-ht_1 small-ht_0))
(begin-unsafe
(set-box!
small-ht_1
(hash-set (unbox small-ht_1) 1 val_0))))))
(let ((small-ht_0 (namespace-phase-level-to-definitions m-ns_0)))
(let ((val_0 (namespace->definitions existing-m-ns_0 1)))
(let ((small-ht_1 small-ht_0))
(begin-unsafe
(set-box!
small-ht_1
(hash-set (unbox small-ht_1) 1 val_0))))))
(hash-set!
(namespace-module-instances
(let ((or-part_0 (namespace-root-namespace ns_0)))
(if or-part_0 or-part_0 ns_0)))
name_0
mi_0)
(let ((small-ht_0 (module-instance-phase-level-to-state mi_0)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set (unbox small-ht_0) 0 'started)))))
(begin
(let ((small-ht_0 (namespace-phase-to-namespace m-ns_0)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set (unbox small-ht_0) 0-phase_0 m-ns_0))))
(begin
(let ((small-ht_0
(namespace-phase-level-to-definitions m-ns_0)))
(let ((val_0 (namespace->definitions existing-m-ns_0 0)))
(let ((small-ht_1 small-ht_0))
(begin-unsafe
(set-box!
small-ht_1
(hash-set (unbox small-ht_1) 0 val_0))))))
(begin
(let ((small-ht_0
(module-instance-phase-level-to-state mi_0)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set (unbox small-ht_0) 0 'started))))
(let ((at-phase_0
(let ((or-part_0
(hash-ref
(namespace-module-instances ns_0)
0-phase_0
#f)))
(if or-part_0
or-part_0
(let ((at-phase_0 (make-hasheq)))
(begin
(hash-set!
(namespace-module-instances ns_0)
0-phase_0
at-phase_0)
at-phase_0))))))
(hash-set! at-phase_0 name_0 mi_0)))))))))))
(define namespace-create-module-instance!
(lambda (ns_0 name_0 0-phase_0 m_0 mpi_0)
(let ((m-ns_0
(if (1/namespace? ns_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))
(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)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set (unbox small-ht_0) 0-phase_0 m-ns_0))))
(let ((mi_0 (make-module-instance m-ns_0 m_0)))
(begin
(if (module-cross-phase-persistent? m_0)
(hash-set! (namespace-module-instances ns_0) name_0 mi_0)
(let ((at-phase_0
(let ((or-part_0
(hash-ref
(namespace-module-instances ns_0)
0-phase_0
#f)))
(if or-part_0
or-part_0
(let ((at-phase_0 (make-hasheq)))
(begin
(hash-set!
(namespace-module-instances ns_0)
0-phase_0
at-phase_0)
at-phase_0))))))
(hash-set! at-phase_0 name_0 mi_0)))
mi_0))))))
(define check-availablilty
(lambda (mi_0 check-available-at-phase-level_0 unavailable-callback_0)
(let ((m_0 (module-instance-module mi_0)))
(if (if m_0
(if (<=
(module-min-phase-level m_0)
(add1 check-available-at-phase-level_0)
(module-max-phase-level m_0))
(not
(let ((small-ht_0 (module-instance-phase-level-to-state mi_0)))
(let ((key_0 (add1 check-available-at-phase-level_0)))
(let ((small-ht_1 small-ht_0))
(begin-unsafe (hash-ref (unbox small-ht_1) key_0 #f))))))
#f)
#f)
(|#%app| unavailable-callback_0 mi_0)
mi_0))))
(define namespace->module-namespace.1
(|#%name|
namespace->module-namespace
(lambda (check-available-at-phase-level66_0
complain-on-failure?65_0
unavailable-callback67_0
ns71_0
name72_0
0-phase73_0)
(begin
(let ((mi_0
(namespace->module-instance.1
check-available-at-phase-level66_0
complain-on-failure?65_0
unavailable-callback67_0
ns71_0
name72_0
0-phase73_0)))
(if mi_0 (module-instance-namespace mi_0) #f))))))
(define namespace-record-module-instance-attached!
(lambda (ns_0 mod-name_0 phase_0)
(let ((mi_0
(namespace->module-instance.1 #f #f void ns_0 mod-name_0 phase_0)))
(set-module-instance-attached?! mi_0 #t))))
(define module-force-bulk-binding!
(lambda (m_0 ns_0)
(|#%app|
(module-force-bulk-binding m_0)
(namespace-bulk-binding-registry ns_0))))
(define namespace-module-instantiate!.1
(|#%name|
namespace-module-instantiate!
(lambda (otherwise-available?77_0
run-phase75_0
seen78_0
seen-list79_0
skip-run?76_0
ns85_0
mpi86_0
instance-phase87_0)
(begin
(let ((run-phase_0
(if (eq? run-phase75_0 unsafe-undefined)
(namespace-phase ns85_0)
run-phase75_0)))
(begin
(if (1/module-path-index? mpi86_0)
(void)
(error "not a module path index:" mpi86_0))
(let ((name_0 (1/module-path-index-resolve mpi86_0 #t)))
(let ((m_0 (namespace->module ns85_0 name_0)))
(begin
(if m_0
(void)
(begin-unsafe
(raise-arguments-error
'instantiate
"unknown module"
"module name"
(module-name->error-string name_0))))
(let ((instantiate!_0
(|#%name|
instantiate!
(lambda (instance-phase_0 run-phase_1 ns_0)
(begin
(let ((mi_0
(let ((or-part_0
(namespace->module-instance.1
#f
#f
void
ns_0
name_0
instance-phase_0)))
(if or-part_0
or-part_0
(namespace-create-module-instance!
ns_0
name_0
instance-phase_0
m_0
mpi86_0)))))
(run-module-instance!.1
otherwise-available?77_0
run-phase_1
seen78_0
seen-list79_0
skip-run?76_0
mi_0
ns_0)))))))
(if (module-cross-phase-persistent? m_0)
(instantiate!_0
0
0
(let ((or-part_0 (namespace-root-namespace ns85_0)))
(if or-part_0 or-part_0 ns85_0)))
(instantiate!_0
instance-phase87_0
run-phase_0
ns85_0))))))))))))
(define namespace-module-visit!.1
(|#%name|
namespace-module-visit!
(lambda (visit-phase89_0 ns91_0 mpi92_0 instance-phase93_0)
(begin
(let ((visit-phase_0
(if (eq? visit-phase89_0 unsafe-undefined)
(namespace-phase ns91_0)
visit-phase89_0)))
(let ((temp190_0 (add1 visit-phase_0)))
(namespace-module-instantiate!.1
#t
temp190_0
hash2610
null
#f
ns91_0
mpi92_0
instance-phase93_0)))))))
(define namespace-module-make-available!.1
(|#%name|
namespace-module-make-available!
(lambda (visit-phase95_0 ns97_0 mpi98_0 instance-phase99_0)
(begin
(let ((visit-phase_0
(if (eq? visit-phase95_0 unsafe-undefined)
(namespace-phase ns97_0)
visit-phase95_0)))
(let ((temp194_0 (add1 visit-phase_0)))
(namespace-module-instantiate!.1
#t
temp194_0
hash2610
null
#t
ns97_0
mpi98_0
instance-phase99_0)))))))
(define run-module-instance!.1
(|#%name|
run-module-instance!
(lambda (otherwise-available?103_0
run-phase101_0
seen104_0
seen-list105_0
skip-run?102_0
mi111_0
ns112_0)
(begin
(begin
(if log-performance?
(start-performance-region 'eval 'requires)
(void))
(begin0
(let ((m-ns_0 (module-instance-namespace mi111_0)))
(let ((instance-phase_0 (namespace-0-phase m-ns_0)))
(let ((run-phase-level_0
(phase- run-phase101_0 instance-phase_0)))
(if (if (if skip-run?102_0
skip-run?102_0
(eq?
'started
(let ((small-ht_0
(module-instance-phase-level-to-state
mi111_0)))
(begin-unsafe
(hash-ref
(unbox small-ht_0)
run-phase-level_0
#f)))))
(let ((or-part_0 (not otherwise-available?103_0)))
(if or-part_0
or-part_0
(module-instance-made-available? mi111_0)))
#f)
(void)
(let ((m_0 (module-instance-module mi111_0)))
(begin
(if m_0
(void)
(error
'require
"import cycle detected; trying to run module being expanded"))
(let ((mpi_0 (namespace-mpi m-ns_0)))
(let ((bulk-binding-registry_0
(namespace-bulk-binding-registry m-ns_0)))
(begin
(if (hash-ref seen104_0 mi111_0 #f)
(error
'require
(apply
string-append
"import cycle detected during module instantiation\n"
" dependency chain:"
(module-instances->indented-module-names
mi111_0
seen-list105_0)))
(void))
(if (module-instance-shifted-requires mi111_0)
(void)
(set-module-instance-shifted-requires!
mi111_0
(reverse$1
(let ((lst_0 (module-requires m_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((phase+mpis_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((app_0
(car
phase+mpis_0)))
(cons
app_0
(reverse$1
(let ((lst_2
(cdr
phase+mpis_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_3)
(begin
(if (pair?
lst_3)
(let ((req-mpi_0
(unsafe-car
lst_3)))
(let ((rest_1
(unsafe-cdr
lst_3)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(module-path-index-shift
req-mpi_0
(module-self
m_0)
mpi_0)
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
lst_2)))))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
(let ((lst_0
(module-instance-shifted-requires
mi111_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((phase+mpis_0
(unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(let ((req-phase_0
(car phase+mpis_0)))
(begin
(let ((lst_2
(cdr
phase+mpis_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (lst_3)
(begin
(if (pair?
lst_3)
(let ((req-mpi_0
(unsafe-car
lst_3)))
(let ((rest_1
(unsafe-cdr
lst_3)))
(begin
(let ((temp198_0
(phase+
instance-phase_0
req-phase_0)))
(let ((temp202_0
(hash-set
seen104_0
mi111_0
#t)))
(let ((temp203_0
(cons
mi111_0
seen-list105_0)))
(let ((temp202_1
temp202_0)
(temp198_1
temp198_0))
(namespace-module-instantiate!.1
otherwise-available?103_0
run-phase101_0
temp202_1
temp203_0
skip-run?102_0
ns112_0
req-mpi_0
temp198_1)))))
(for-loop_1
rest_1))))
(values)))))))
(for-loop_1 lst_2))))
(void)))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)
(if (begin-unsafe (not instance-phase_0))
(void)
(begin
(let ((start_0 (module-max-phase-level m_0)))
(let ((end_0
(sub1 (module-min-phase-level m_0))))
(let ((start_1 start_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (> pos_0 end_0)
(begin
(let ((phase_0
(phase+
pos_0
instance-phase_0)))
(if (if (not
skip-run?102_0)
(eqv?
phase_0
run-phase101_0)
#f)
(if (eq?
'started
(let ((small-ht_0
(module-instance-phase-level-to-state
mi111_0)))
(begin-unsafe
(hash-ref
(unbox
small-ht_0)
pos_0
#f))))
(void)
(begin
(let ((small-ht_0
(module-instance-phase-level-to-state
mi111_0)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set
(unbox
small-ht_0)
pos_0
'started))))
(begin
(void
(namespace->definitions
m-ns_0
pos_0))
(let ((p-ns_0
(namespace->namespace-at-phase
m-ns_0
phase_0)))
(let ((insp_0
(module-inspector
m_0)))
(let ((data-box_0
(module-instance-data-box
mi111_0)))
(let ((prep_0
(module-prepare-instance
m_0)))
(let ((go_0
(module-instantiate-phase
m_0)))
(begin
(|#%app|
prep_0
data-box_0
p-ns_0
instance-phase_0
mpi_0
bulk-binding-registry_0
insp_0)
(|#%app|
go_0
data-box_0
p-ns_0
instance-phase_0
pos_0
mpi_0
bulk-binding-registry_0
insp_0))))))))))
(if (if otherwise-available?103_0
(if (not
(negative?
run-phase101_0))
(not
(let ((small-ht_0
(module-instance-phase-level-to-state
mi111_0)))
(begin-unsafe
(hash-ref
(unbox
small-ht_0)
pos_0
#f))))
#f)
#f)
(begin
(let ((ht_0
(namespace-available-module-instances
ns112_0)))
(let ((xform_0
(lambda (l_0)
(cons
mi111_0
l_0))))
(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)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set
(unbox
small-ht_0)
pos_0
'available)))))
(void))))
(for-loop_0 (+ pos_0 -1)))
(values)))))))
(for-loop_0 start_1))))))
(void)))
(if otherwise-available?103_0
(set-module-instance-made-available?!
mi111_0
#t)
(void))
(if skip-run?102_0
(void)
(let ((small-ht_0
(module-instance-phase-level-to-state
mi111_0)))
(begin-unsafe
(set-box!
small-ht_0
(hash-set
(unbox small-ht_0)
run-phase-level_0
'started))))))))))))))
(if log-performance? (end-performance-region) (void))))))))
(define namespace-visit-available-modules!
(let ((namespace-visit-available-modules!_0
(|#%name|
namespace-visit-available-modules!
(lambda (ns115_0 run-phase114_0)
(begin
(let ((run-phase_0
(if (eq? run-phase114_0 unsafe-undefined)
(namespace-phase ns115_0)
run-phase114_0)))
(namespace-run-available-modules!
ns115_0
(add1 run-phase_0))))))))
(case-lambda
((ns_0) (namespace-visit-available-modules!_0 ns_0 unsafe-undefined))
((ns_0 run-phase114_0)
(namespace-visit-available-modules!_0 ns_0 run-phase114_0)))))
(define namespace-run-available-modules!
(let ((namespace-run-available-modules!_0
(|#%name|
namespace-run-available-modules!
(lambda (ns117_0 run-phase116_0)
(begin
(let ((run-phase_0
(if (eq? run-phase116_0 unsafe-undefined)
(namespace-phase ns117_0)
run-phase116_0)))
(registry-call-with-lock
(namespace-module-registry$1 ns117_0)
(lambda ()
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((mis_0
(hash-ref
(namespace-available-module-instances
ns117_0)
run-phase_0
null)))
(if (null? mis_0)
(void)
(begin
(hash-set!
(namespace-available-module-instances
ns117_0)
run-phase_0
null)
(let ((lst_0 (reverse$1 mis_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((mi_0 (unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(begin
(run-module-instance!.1
#f
run-phase_0
hash2610
null
#f
mi_0
ns117_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)
(loop_0)))))))))
(loop_0))))))))))
(case-lambda
((ns_0) (namespace-run-available-modules!_0 ns_0 unsafe-undefined))
((ns_0 run-phase116_0)
(namespace-run-available-modules!_0 ns_0 run-phase116_0)))))
(define namespace-primitive-module-visit!
(lambda (ns_0 name_0)
(let ((mi_0
(hash-ref
(namespace-module-instances ns_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
(lambda (phase-shift120_0 shift-from118_0 shift-to119_0 ns124_0 mu125_0)
(begin
(let ((mod_0 (module-use-module mu125_0)))
(let ((mi_0
(let ((temp215_0
(1/module-path-index-resolve
(if shift-from118_0
(module-path-index-shift
mod_0
shift-from118_0
shift-to119_0)
mod_0))))
(namespace->module-instance.1
#f
#t
void
ns124_0
temp215_0
phase-shift120_0))))
(let ((m-ns_0 (module-instance-namespace mi_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_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
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((phase+mpis_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((app_0 (car phase+mpis_0)))
(cons
app_0
(reverse$1
(let ((lst_1 (cdr phase+mpis_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1 lst_2)
(begin
(if (pair? lst_2)
(let ((req-mpi_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(module-path-index-unresolve
req-mpi_0)
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1 null lst_1)))))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null requires_0))))))
(define module-compute-access!
(lambda (m_0)
(let ((ht_0 (module-provides m_0)))
(let ((access_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((phase_0 at-phase_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1 i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
at-phase_0
i_1))
(case-lambda
((sym_0
binding/p_0)
(let ((table_2
(let ((table_2
(call-with-values
(lambda ()
(let ((app_0
(module-binding-sym
(provided-as-binding
binding/p_0))))
(values
app_0
(if (provided-as-protected?
binding/p_0)
'protected
'provided))))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))))
(for-loop_1
table_2
(hash-iterate-next
at-phase_0
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
table_1))))))
(for-loop_1
hash2725
(hash-iterate-first
at-phase_0))))))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(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)))))
(define module-instances->indented-module-names
(lambda (mi_0 seen-list_0)
(let ((mi->name_0
(|#%name|
mi->name
(lambda (mi_1)
(begin
(format
"\n ~a"
(1/module-path-index-resolve
(namespace-mpi (module-instance-namespace mi_1)))))))))
(let ((app_0 (mi->name_0 mi_0)))
(cons
app_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (seen-list_1)
(begin
(if (null? seen-list_1)
'()
(if (eq? mi_0 (car seen-list_1))
(list (mi->name_0 mi_0))
(let ((app_1 (mi->name_0 (car seen-list_1))))
(cons app_1 (loop_0 (cdr seen-list_1)))))))))))
(loop_0 seen-list_0)))))))
(define binding->module-instance
(lambda (b_0 ns_0 phase_0 id_0)
(let ((at-phase_0 (phase- phase_0 (module-binding-phase b_0))))
(let ((mi_0
(let ((temp2_0
(1/module-path-index-resolve (module-binding-module b_0))))
(let ((temp4_0 (module-binding-phase b_0)))
(let ((temp5_0 (lambda (mi_0) 'unavailable)))
(let ((temp4_1 temp4_0) (temp2_1 temp2_0))
(namespace->module-instance.1
temp4_1
#f
temp5_0
ns_0
temp2_1
at-phase_0)))))))
(begin
(if (eq? mi_0 'unavailable)
(raise-syntax-error$1
#f
(let ((app_0
(string-append
"module mismatch;\n"
" attempted to use a module that is not available\n"
" possible cause:\n"
" using (dynamic-require .... #f)\n"
" but need (dynamic-require .... 0)\n"
" module: ~s\n"
" phase: ~s")))
(let ((app_1 (module-binding-module b_0)))
(format
app_0
app_1
(phase+ at-phase_0 (module-binding-phase b_0)))))
id_0)
(void))
(if mi_0
(void)
(let ((app_0
(string-append
"namespace mismatch; cannot locate module instance\n"
" module: ~s\n"
" use phase: ~a\n"
" definition phase: ~a\n"
" for identifier: ~s")))
(let ((app_1 (module-binding-module b_0)))
(error
'expand
app_0
app_1
phase_0
(module-binding-phase b_0)
id_0))))
mi_0)))))
(define check-access
(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)))
#f))))
(define resolve+shift/extra-inspector
(lambda (id_0 phase_0 ns_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (id_1 in-s_0)
(begin
(let ((b_0 (resolve+shift.1 #f #f null #t #f id_1 phase_0)))
(let ((c1_0 (binding-free=id b_0)))
(if c1_0
(begin
(if (if (module-binding? b_0)
(not
(let ((mpi_0 (module-binding-module b_0)))
(begin-unsafe
(eq? top-level-module-path-index mpi_0))))
#f)
(let ((mi_0
(binding->module-instance b_0 ns_0 phase_0 id_1)))
(check-access b_0 mi_0 id_1 in-s_0 "provided binding"))
(void))
(let ((next-b_0 (loop_0 c1_0 (if in-s_0 in-s_0 id_1))))
(if (not next-b_0)
b_0
(if (if (module-binding? next-b_0)
(if (not
(module-binding-extra-inspector next-b_0))
(syntax-inspector id_1)
#f)
#f)
(let ((temp5_0 (syntax-inspector id_1)))
(module-binding-update.1
temp5_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
next-b_0))
next-b_0))))
b_0))))))))
(loop_0 id_0 #f))))
(define-values
(1/prop:set!-transformer 1/set!-transformer? set!-transformer-value)
(make-struct-type-property
'set!-transformer
(lambda (v_0 info_0)
(begin
(if (let ((or-part_0
(if (procedure? v_0)
(let ((or-part_0 (procedure-arity-includes? v_0 1)))
(if or-part_0
or-part_0
(procedure-arity-includes? v_0 2)))
#f)))
(if or-part_0 or-part_0 (exact-nonnegative-integer? v_0)))
(void)
(raise-argument-error
'guard-for-prop:set!-transformer
(string-append
"(or/c (procedure-arity-includes? proc 1)\n"
" (procedure-arity-includes? proc 2)\n"
" exact-nonnegative-integer?)")
v_0))
(begin
(if (exact-nonnegative-integer? v_0)
(begin
(if (<= v_0 (list-ref info_0 1))
(void)
(raise-arguments-error
'guard-for-prop:set!-transformer
"field index >= initialized-field count for structure type"
"field index"
v_0
"initialized-field count"
(list-ref info_0 1)))
(if (member v_0 (list-ref info_0 5))
(void)
(raise-arguments-error
'guard-for-prop:set!-transformer
"field index not declared immutable"
"field index"
v_0)))
(void))
(let ((ref_0 (list-ref info_0 3)))
(if (integer? v_0)
(lambda (t_0)
(let ((p_0 (|#%app| ref_0 t_0 v_0)))
(if (if (procedure? p_0) (procedure-arity-includes? p_0 1) #f)
p_0
(lambda (s_0) (error "bad syntax:" s_0)))))
(lambda (t_0) v_0))))))))
(define 1/make-set!-transformer
(let ((struct:set!-transformer_0
(make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0)))
(let ((effect699
(struct-type-install-properties!
struct:set!-transformer_0
'set!-transformer
1
0
#f
(list (cons 1/prop:set!-transformer 0))
(current-inspector)
#f
'(0)
#f
'set!-transformer)))
(let ((set!-transformer1_0
(|#%name|
set!-transformer
(record-constructor
(make-record-constructor-descriptor
struct:set!-transformer_0
#f
#f)))))
(let ((set!-transformer?_0
(|#%name|
set!-transformer?
(record-predicate struct:set!-transformer_0))))
(let ((set!-transformer?_1
(|#%name|
set!-transformer?
(lambda (v)
(if (set!-transformer?_0 v)
#t
($value
(if (impersonator? v)
(set!-transformer?_0 (impersonator-val v))
#f)))))))
(let ((set!-transformer-proc_0
(|#%name|
set!-transformer-proc
(record-accessor struct:set!-transformer_0 0))))
(let ((set!-transformer-proc_1
(|#%name|
set!-transformer-proc
(lambda (s)
(if (set!-transformer?_0 s)
(set!-transformer-proc_0 s)
($value
(impersonate-ref
set!-transformer-proc_0
struct:set!-transformer_0
0
s
'set!-transformer
'proc)))))))
(|#%name|
make-set!-transformer
(lambda (proc_0)
(begin
(begin
(if (if (procedure? proc_0)
(procedure-arity-includes? proc_0 1)
#f)
(void)
(raise-argument-error
'make-set!-transformer
"(procedure-arity-includes/c 1)"
proc_0))
(set!-transformer1_0 proc_0)))))))))))))
(define 1/set!-transformer-procedure
(|#%name|
set!-transformer-procedure
(lambda (t_0)
(begin
(let ((v_0 (|#%app| (set!-transformer-value t_0) t_0)))
(if (procedure-arity-includes? v_0 1)
v_0
(lambda (s_0) (|#%app| v_0 t_0 s_0))))))))
(define empty-env hash2610)
(define env-extend (lambda (env_0 key_0 val_0) (hash-set env_0 key_0 val_0)))
(define lookup
(lambda (env_0 key_0 default_0) (hash-ref env_0 key_0 default_0)))
(define variable (gensym 'variable))
(define variable?
(lambda (t_0)
(let ((or-part_0 (eq? t_0 variable)))
(if or-part_0 or-part_0 (local-variable? t_0)))))
(define struct:local-variable
(make-record-type-descriptor*
'local-variable
#f
(|#%nongenerative-uid| local-variable)
#f
#f
1
0))
(define effect_2447
(struct-type-install-properties!
struct:local-variable
'local-variable
1
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'local-variable))
(define local-variable1.1
(|#%name|
local-variable
(record-constructor
(make-record-constructor-descriptor struct:local-variable #f #f))))
(define local-variable?
(|#%name| local-variable? (record-predicate struct:local-variable)))
(define local-variable-id
(|#%name| local-variable-id (record-accessor struct:local-variable 0)))
(define substitute-variable.1
(|#%name|
substitute-variable
(lambda (no-stops?2_0 id4_0 t5_0)
(begin
(if (if no-stops?2_0 (local-variable? t5_0) #f)
(let ((bind-id_0 (local-variable-id t5_0)))
(let ((pruned-id_0
(let ((app_0 (syntax-disarm$1 bind-id_0)))
(datum->syntax$1
app_0
(syntax-e$1 bind-id_0)
id4_0
id4_0))))
(let ((new-id_0
(if (syntax-any-macro-scopes? id4_0)
(1/syntax-property-remove
pruned-id_0
original-property-sym)
pruned-id_0)))
(syntax-rearm$1 new-id_0 id4_0))))
id4_0)))))
(define missing (gensym 'missing))
(define transformer?
(lambda (t_0)
(let ((or-part_0 (procedure? t_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (1/set!-transformer? t_0)))
(if or-part_1 or-part_1 (1/rename-transformer? t_0)))))))
(define transformer->procedure
(lambda (t_0)
(if (1/set!-transformer? t_0)
(1/set!-transformer-procedure t_0)
(if (1/rename-transformer? t_0) (lambda (s_0) s_0) t_0))))
(define struct:core-form
(make-record-type-descriptor*
'core-form
#f
(|#%nongenerative-uid| core-form)
#f
#f
2
0))
(define effect_2019
(struct-type-install-properties!
struct:core-form
'core-form
2
0
#f
(list (cons prop:authentic #t))
#f
#f
'(0 1)
#f
'core-form))
(define core-form7.1
(|#%name|
core-form
(record-constructor
(make-record-constructor-descriptor struct:core-form #f #f))))
(define core-form? (|#%name| core-form? (record-predicate struct:core-form)))
(define core-form-expander
(|#%name| core-form-expander (record-accessor struct:core-form 0)))
(define core-form-name
(|#%name| core-form-name (record-accessor struct:core-form 1)))
(define add-binding!.1
(|#%name|
add-binding!
(lambda (in8_0 just-for-nominal?9_0 id12_0 binding13_0 phase14_0)
(begin
(begin
(check-id-taint id12_0 in8_0)
(let ((temp47_0 (syntax-scope-set id12_0 phase14_0)))
(let ((temp48_0 (syntax-e$1 id12_0)))
(let ((temp47_1 temp47_0))
(add-binding-in-scopes!.1
just-for-nominal?9_0
temp47_1
temp48_0
binding13_0)))))))))
(define add-bulk-binding!.1
(|#%name|
add-bulk-binding!
(lambda (in16_0 shadow-except17_0 s20_0 binding21_0 phase22_0)
(begin
(begin
(if (syntax-tainted?$1 s20_0)
(raise-syntax-error$1
#f
"cannot bind from tainted syntax"
in16_0
s20_0)
(void))
(let ((temp51_0 (syntax-scope-set s20_0 phase22_0)))
(add-bulk-binding-in-scopes!.1
shadow-except17_0
temp51_0
binding21_0)))))))
(define add-local-binding!.1
(|#%name|
add-local-binding!
(lambda (frame-id25_0 in26_0 local-sym24_0 id30_0 phase31_0 counter32_0)
(begin
(begin
(check-id-taint id30_0 in26_0)
(let ((c_0 (add1 (unbox counter32_0))))
(begin
(set-box! counter32_0 c_0)
(let ((sym_0 (syntax-content id30_0)))
(let ((key_0
(string->uninterned-symbol
(let ((app_0
(symbol->immutable-string
(if local-sym24_0 local-sym24_0 sym_0))))
(string-append-immutable
app_0
"_"
(number->string c_0))))))
(begin
(let ((temp54_0 (syntax-scope-set id30_0 phase31_0)))
(let ((temp56_0
(make-local-binding.1 frame-id25_0 #f key_0)))
(let ((temp54_1 temp54_0))
(add-binding-in-scopes!.1
#f
temp54_1
sym_0
temp56_0))))
key_0))))))))))
(define check-id-taint
(lambda (id_0 in-s_0)
(if (syntax-tainted?$1 id_0)
(raise-syntax-error$1 #f "cannot bind tainted identifier" in-s_0 id_0)
(void))))
(define binding-lookup.1
(|#%name|
binding-lookup
(lambda (in34_0
out-of-context-as-variable?35_0
b38_0
env39_0
lift-envs40_0
ns41_0
phase42_0
id43_0)
(begin
(if (module-binding? b38_0)
(let ((top-level?_0
(let ((mpi_0 (module-binding-module b38_0)))
(begin-unsafe (eq? top-level-module-path-index mpi_0)))))
(let ((mi_0
(if (not top-level?_0)
(binding->module-instance b38_0 ns41_0 phase42_0 id43_0)
#f)))
(let ((m_0 (if mi_0 (module-instance-module mi_0) #f)))
(let ((primitive?_0 (if m_0 (module-primitive? m_0) #f)))
(let ((m-ns_0
(if top-level?_0
ns41_0
(if mi_0 (module-instance-namespace mi_0) #f))))
(begin
(check-taint id43_0)
(let ((t_0
(let ((app_0 (module-binding-phase b38_0)))
(namespace-get-transformer
m-ns_0
app_0
(module-binding-sym b38_0)
variable))))
(let ((protected?_0
(if mi_0
(check-access
b38_0
mi_0
id43_0
in34_0
(if (variable? t_0) "variable" "transformer"))
#f)))
(let ((insp_0
(if mi_0
(if (module-instance-module mi_0)
(module-inspector
(module-instance-module mi_0))
#f)
#f)))
(values
t_0
primitive?_0
insp_0
protected?_0))))))))))
(if (local-binding? b38_0)
(let ((t_0
(let ((key_0 (local-binding-key b38_0)))
(begin-unsafe (hash-ref env39_0 key_0 missing)))))
(if (eq? t_0 missing)
(values
(let ((or-part_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((lift-env_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1
(let ((env_0
(unbox
lift-env_0)))
(let ((key_0
(local-binding-key
b38_0)))
(let ((env_1 env_0))
(begin-unsafe
(hash-ref
env_1
key_0
#f)))))))
(values result_1))))
(if (if (not
(let ((x_0
(list lift-env_0)))
result_1))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #f lift-envs40_0)))))
(if or-part_0
or-part_0
(if out-of-context-as-variable?35_0
variable
(error "identifier used out of context:" id43_0))))
#f
#f
#f)
(begin (check-taint id43_0) (values t_0 #f #f #f))))
(error "internal error: unknown binding for lookup:" b38_0)))))))
(define check-taint
(lambda (id_0)
(if (syntax-tainted?$1 id_0)
(raise-syntax-error$1
#f
"cannot use identifier tainted by macro transformation"
id_0)
(void))))
(define existing-binding-key
(lambda (id_0 phase_0)
(let ((b_0 (resolve+shift.1 #f #f null #t #f id_0 phase_0)))
(begin
(if (local-binding? b_0)
(void)
(raise-syntax-error$1
#f
"expected an existing local binding for an already-expanded identifier"
id_0))
(local-binding-key b_0)))))
(define cons-ish (lambda (a_0 b_0) (if (null? b_0) a_0 (cons a_0 b_0))))
(define free-id-set
(lambda (phase_0 ids_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_0 lst_0)
(begin
(if (pair? lst_0)
(let ((id_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((ht_1
(let ((ht_1
(let ((sym_0
(identifier-binding-symbol$1
id_0
phase_0)))
(hash-set
ht_0
sym_0
(cons-ish
id_0
(hash-ref ht_0 sym_0 null))))))
(values ht_1))))
(for-loop_0 ht_1 rest_0))))
ht_0))))))
(for-loop_0 hash2610 ids_0)))))
(define empty-free-id-set (free-id-set 0 null))
(define free-id-set-empty? (lambda (fs_0) (eq? fs_0 empty-free-id-set)))
(define free-id-set-member?
(lambda (fs_0 phase_0 given-id_0)
(if (begin-unsafe (eq? fs_0 empty-free-id-set))
#f
(let ((lst_0
(hash-ref
fs_0
(identifier-binding-symbol$1 given-id_0 phase_0)
null)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (not (null? lst_1))
(let ((id_0 (if (pair? lst_1) (car lst_1) lst_1)))
(let ((rest_0 (if (pair? lst_1) (cdr lst_1) null)))
(let ((id_1 id_0))
(let ((result_1
(let ((result_1
(free-identifier=?$1
id_1
given-id_0
phase_0
phase_0)))
(values result_1))))
(if (if (not (let ((x_0 (list id_1))) result_1))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1)))))
result_0))))))
(for-loop_0 #f lst_0)))))))
(define free-id-set-empty-or-just-module*?
(lambda (fs_0) (let ((c_0 (hash-count fs_0))) (<= c_0 1))))
(define struct:expand-context/outer
(make-record-type-descriptor*
'expand-context
struct:root-expand-context/outer
(|#%nongenerative-uid| expand-context)
#f
#f
11
0))
(define effect_2428
(struct-type-install-properties!
struct:expand-context/outer
'expand-context
11
0
struct:root-expand-context/outer
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9 10)
#f
'expand-context/outer))
(define expand-context/outer1.1
(|#%name|
expand-context/outer
(record-constructor
(make-record-constructor-descriptor struct:expand-context/outer #f #f))))
(define expand-context/outer?
(|#%name| expand-context? (record-predicate struct:expand-context/outer)))
(define expand-context/outer-context
(|#%name|
expand-context-context
(record-accessor struct:expand-context/outer 0)))
(define expand-context/outer-env
(|#%name|
expand-context-env
(record-accessor struct:expand-context/outer 1)))
(define expand-context/outer-scopes
(|#%name|
expand-context-scopes
(record-accessor struct:expand-context/outer 2)))
(define expand-context/outer-def-ctx-scopes
(|#%name|
expand-context-def-ctx-scopes
(record-accessor struct:expand-context/outer 3)))
(define expand-context/outer-binding-layer
(|#%name|
expand-context-binding-layer
(record-accessor struct:expand-context/outer 4)))
(define expand-context/outer-reference-records
(|#%name|
expand-context-reference-records
(record-accessor struct:expand-context/outer 5)))
(define expand-context/outer-only-immediate?
(|#%name|
expand-context-only-immediate?
(record-accessor struct:expand-context/outer 6)))
(define expand-context/outer-need-eventually-defined
(|#%name|
expand-context-need-eventually-defined
(record-accessor struct:expand-context/outer 7)))
(define expand-context/outer-current-introduction-scopes
(|#%name|
expand-context-current-introduction-scopes
(record-accessor struct:expand-context/outer 8)))
(define expand-context/outer-current-use-scopes
(|#%name|
expand-context-current-use-scopes
(record-accessor struct:expand-context/outer 9)))
(define expand-context/outer-name
(|#%name|
expand-context-name
(record-accessor struct:expand-context/outer 10)))
(define struct:expand-context/inner
(make-record-type-descriptor*
'expand-context/inner
struct:root-expand-context/inner
(|#%nongenerative-uid| expand-context/inner)
#f
#f
22
0))
(define effect_2689
(struct-type-install-properties!
struct:expand-context/inner
'expand-context/inner
22
0
struct:root-expand-context/inner
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21)
#f
'expand-context/inner))
(define expand-context/inner2.1
(|#%name|
expand-context/inner
(record-constructor
(make-record-constructor-descriptor struct:expand-context/inner #f #f))))
(define expand-context/inner?
(|#%name|
expand-context/inner?
(record-predicate struct:expand-context/inner)))
(define expand-context/inner-to-parsed?
(|#%name|
expand-context/inner-to-parsed?
(record-accessor struct:expand-context/inner 0)))
(define expand-context/inner-phase
(|#%name|
expand-context/inner-phase
(record-accessor struct:expand-context/inner 1)))
(define expand-context/inner-namespace
(|#%name|
expand-context/inner-namespace
(record-accessor struct:expand-context/inner 2)))
(define expand-context/inner-just-once?
(|#%name|
expand-context/inner-just-once?
(record-accessor struct:expand-context/inner 3)))
(define expand-context/inner-module-begin-k
(|#%name|
expand-context/inner-module-begin-k
(record-accessor struct:expand-context/inner 4)))
(define expand-context/inner-allow-unbound?
(|#%name|
expand-context/inner-allow-unbound?
(record-accessor struct:expand-context/inner 5)))
(define expand-context/inner-in-local-expand?
(|#%name|
expand-context/inner-in-local-expand?
(record-accessor struct:expand-context/inner 6)))
(define |expand-context/inner-keep-#%expression?|
(|#%name|
|expand-context/inner-keep-#%expression?|
(record-accessor struct:expand-context/inner 7)))
(define expand-context/inner-stops
(|#%name|
expand-context/inner-stops
(record-accessor struct:expand-context/inner 8)))
(define expand-context/inner-declared-submodule-names
(|#%name|
expand-context/inner-declared-submodule-names
(record-accessor struct:expand-context/inner 9)))
(define expand-context/inner-lifts
(|#%name|
expand-context/inner-lifts
(record-accessor struct:expand-context/inner 10)))
(define expand-context/inner-lift-envs
(|#%name|
expand-context/inner-lift-envs
(record-accessor struct:expand-context/inner 11)))
(define expand-context/inner-module-lifts
(|#%name|
expand-context/inner-module-lifts
(record-accessor struct:expand-context/inner 12)))
(define expand-context/inner-require-lifts
(|#%name|
expand-context/inner-require-lifts
(record-accessor struct:expand-context/inner 13)))
(define expand-context/inner-to-module-lifts
(|#%name|
expand-context/inner-to-module-lifts
(record-accessor struct:expand-context/inner 14)))
(define expand-context/inner-requires+provides
(|#%name|
expand-context/inner-requires+provides
(record-accessor struct:expand-context/inner 15)))
(define expand-context/inner-observer
(|#%name|
expand-context/inner-observer
(record-accessor struct:expand-context/inner 16)))
(define expand-context/inner-for-serializable?
(|#%name|
expand-context/inner-for-serializable?
(record-accessor struct:expand-context/inner 17)))
(define expand-context/inner-to-correlated-linklet?
(|#%name|
expand-context/inner-to-correlated-linklet?
(record-accessor struct:expand-context/inner 18)))
(define expand-context/inner-normalize-locals?
(|#%name|
expand-context/inner-normalize-locals?
(record-accessor struct:expand-context/inner 19)))
(define expand-context/inner-parsing-expanded?
(|#%name|
expand-context/inner-parsing-expanded?
(record-accessor struct:expand-context/inner 20)))
(define expand-context/inner-skip-visit-available?
(|#%name|
expand-context/inner-skip-visit-available?
(record-accessor struct:expand-context/inner 21)))
(define expand-context/make
(lambda (self-mpi_0
module-scopes_0
post-expansion_0
top-level-bind-scope_0
all-scopes-stx_0
use-site-scopes_0
defined-syms_0
frame-id_0
counter_0
lift-key_0
to-parsed?_0
context_0
phase_0
namespace_0
env_0
scopes_0
def-ctx-scopes_0
binding-layer_0
reference-records_0
only-immediate?_0
just-once?_0
module-begin-k_0
need-eventually-defined_0
allow-unbound?_0
in-local-expand?_0
|keep-#%expression?_0|
stops_0
current-introduction-scopes_0
current-use-scopes_0
declared-submodule-names_0
lifts_0
lift-envs_0
module-lifts_0
require-lifts_0
to-module-lifts_0
requires+provides_0
name_0
observer_0
for-serializable?_0
to-correlated-linklet?_0
normalize-locals?_0
parsing-expanded?_0
skip-visit-available?_0)
(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?_0
phase_0
namespace_0
just-once?_0
module-begin-k_0
allow-unbound?_0
in-local-expand?_0
|keep-#%expression?_0|
stops_0
declared-submodule-names_0
lifts_0
lift-envs_0
module-lifts_0
require-lifts_0
to-module-lifts_0
requires+provides_0
observer_0
for-serializable?_0
to-correlated-linklet?_0
normalize-locals?_0
parsing-expanded?_0
skip-visit-available?_0)
post-expansion_0
use-site-scopes_0
frame-id_0
context_0
env_0
scopes_0
def-ctx-scopes_0
binding-layer_0
reference-records_0
only-immediate?_0
need-eventually-defined_0
current-introduction-scopes_0
current-use-scopes_0
name_0)))
(define expand-context-context
(lambda (v_0) (expand-context/outer-context v_0)))
(define expand-context-env (lambda (v_0) (expand-context/outer-env v_0)))
(define expand-context-scopes (lambda (v_0) (expand-context/outer-scopes v_0)))
(define expand-context-def-ctx-scopes
(lambda (v_0) (expand-context/outer-def-ctx-scopes v_0)))
(define expand-context-binding-layer
(lambda (v_0) (expand-context/outer-binding-layer v_0)))
(define expand-context-reference-records
(lambda (v_0) (expand-context/outer-reference-records v_0)))
(define expand-context-only-immediate?
(lambda (v_0) (expand-context/outer-only-immediate? v_0)))
(define expand-context-need-eventually-defined
(lambda (v_0) (expand-context/outer-need-eventually-defined v_0)))
(define expand-context-current-introduction-scopes
(lambda (v_0) (expand-context/outer-current-introduction-scopes v_0)))
(define expand-context-current-use-scopes
(lambda (v_0) (expand-context/outer-current-use-scopes v_0)))
(define expand-context-name (lambda (v_0) (expand-context/outer-name v_0)))
(define expand-context-to-parsed?
(lambda (v_0)
(expand-context/inner-to-parsed? (root-expand-context/outer-inner v_0))))
(define expand-context-phase
(lambda (v_0)
(expand-context/inner-phase (root-expand-context/outer-inner v_0))))
(define expand-context-namespace
(lambda (v_0)
(expand-context/inner-namespace (root-expand-context/outer-inner v_0))))
(define expand-context-just-once?
(lambda (v_0)
(expand-context/inner-just-once? (root-expand-context/outer-inner v_0))))
(define expand-context-module-begin-k
(lambda (v_0)
(expand-context/inner-module-begin-k
(root-expand-context/outer-inner v_0))))
(define expand-context-allow-unbound?
(lambda (v_0)
(expand-context/inner-allow-unbound?
(root-expand-context/outer-inner v_0))))
(define expand-context-in-local-expand?
(lambda (v_0)
(expand-context/inner-in-local-expand?
(root-expand-context/outer-inner v_0))))
(define |expand-context-keep-#%expression?|
(lambda (v_0)
(|expand-context/inner-keep-#%expression?|
(root-expand-context/outer-inner v_0))))
(define expand-context-stops
(lambda (v_0)
(expand-context/inner-stops (root-expand-context/outer-inner v_0))))
(define expand-context-declared-submodule-names
(lambda (v_0)
(expand-context/inner-declared-submodule-names
(root-expand-context/outer-inner v_0))))
(define expand-context-lifts
(lambda (v_0)
(expand-context/inner-lifts (root-expand-context/outer-inner v_0))))
(define expand-context-lift-envs
(lambda (v_0)
(expand-context/inner-lift-envs (root-expand-context/outer-inner v_0))))
(define expand-context-module-lifts
(lambda (v_0)
(expand-context/inner-module-lifts (root-expand-context/outer-inner v_0))))
(define expand-context-require-lifts
(lambda (v_0)
(expand-context/inner-require-lifts
(root-expand-context/outer-inner v_0))))
(define expand-context-to-module-lifts
(lambda (v_0)
(expand-context/inner-to-module-lifts
(root-expand-context/outer-inner v_0))))
(define expand-context-requires+provides
(lambda (v_0)
(expand-context/inner-requires+provides
(root-expand-context/outer-inner v_0))))
(define expand-context-observer
(lambda (v_0)
(expand-context/inner-observer (root-expand-context/outer-inner v_0))))
(define expand-context-for-serializable?
(lambda (v_0)
(expand-context/inner-for-serializable?
(root-expand-context/outer-inner v_0))))
(define expand-context-to-correlated-linklet?
(lambda (v_0)
(expand-context/inner-to-correlated-linklet?
(root-expand-context/outer-inner v_0))))
(define expand-context-normalize-locals?
(lambda (v_0)
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner v_0))))
(define expand-context-parsing-expanded?
(lambda (v_0)
(expand-context/inner-parsing-expanded?
(root-expand-context/outer-inner v_0))))
(define expand-context-skip-visit-available?
(lambda (v_0)
(expand-context/inner-skip-visit-available?
(root-expand-context/outer-inner v_0))))
(define make-expand-context.1
(|#%name|
make-expand-context
(lambda (for-serializable?4_0
observer6_0
skip-visit-available?7_0
to-correlated-linklet?5_0
to-parsed?3_0
ns13_0)
(begin
(let ((root-ctx_0 (namespace-get-root-expand-ctx ns13_0)))
(let ((self-mpi_0
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner root-ctx_0)))))
(let ((module-scopes_0
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner root-ctx_0)))))
(let ((post-expansion_0
(begin-unsafe
(root-expand-context/outer-post-expansion root-ctx_0))))
(let ((top-level-bind-scope_0
(begin-unsafe
(root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner root-ctx_0)))))
(let ((all-scopes-stx_0
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner root-ctx_0)))))
(let ((use-site-scopes_0
(begin-unsafe
(root-expand-context/outer-use-site-scopes
root-ctx_0))))
(let ((defined-syms_0
(begin-unsafe
(root-expand-context/inner-defined-syms
(root-expand-context/outer-inner root-ctx_0)))))
(let ((frame-id_0
(begin-unsafe
(root-expand-context/outer-frame-id
root-ctx_0))))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((lift-key_0
(begin-unsafe
(root-expand-context/inner-lift-key
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((phase_0 (namespace-phase ns13_0)))
(let ((binding-layer_0
(begin-unsafe
(root-expand-context/outer-frame-id
root-ctx_0))))
(let ((declared-submodule-names_0 hash2610))
(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)
(let ((post-expansion25_0
(begin-unsafe
(root-expand-context/outer-post-expansion root-ctx_0))))
(let ((use-site-scopes26_0
(begin-unsafe
(root-expand-context/outer-use-site-scopes root-ctx_0))))
(let ((frame-id27_0
(begin-unsafe
(root-expand-context/outer-frame-id root-ctx_0))))
(let ((binding-layer28_0
(begin-unsafe
(root-expand-context/outer-frame-id root-ctx_0))))
(let ((inner29_0
(let ((the-struct_0
(root-expand-context/outer-inner ctx_0)))
(if (expand-context/inner? the-struct_0)
(let ((self-mpi30_0
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((module-scopes31_0
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((top-level-bind-scope32_0
(begin-unsafe
(root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((all-scopes-stx33_0
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((defined-syms34_0
(begin-unsafe
(root-expand-context/inner-defined-syms
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((counter35_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((lift-key36_0
(begin-unsafe
(root-expand-context/inner-lift-key
(root-expand-context/outer-inner
root-ctx_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?"
the-struct_0)))))
(let ((binding-layer28_1 binding-layer28_0)
(frame-id27_1 frame-id27_0)
(use-site-scopes26_1 use-site-scopes26_0)
(post-expansion25_1 post-expansion25_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
(lambda ()
(continuation-mark-set-first #f current-expand-context #f root-tag)))
(define get-current-expand-context.1
(|#%name|
get-current-expand-context
(lambda (fail-ok?15_0 who17_0)
(begin
(let ((or-part_0 (force (current-expand-context))))
(if or-part_0
or-part_0
(if fail-ok?15_0
#f
(raise-arguments-error who17_0 "not currently expanding"))))))))
(define current-expand-observe
(make-parameter
#f
(lambda (v_0)
(begin
(if (let ((or-part_0 (not v_0)))
(if or-part_0
or-part_0
(if (procedure? v_0) (procedure-arity-includes? v_0 2) #f)))
(void)
(raise-argument-error
'current-expand-observe
"(or/c (procedure-arity-includes/c 2) #f)"
v_0))
v_0))
'current-expand-observe))
(define as-expression-context
(lambda (ctx_0)
(if (if (eq?
'expression
(begin-unsafe (expand-context/outer-context ctx_0)))
(not (begin-unsafe (expand-context/outer-name ctx_0)))
#f)
ctx_0
(if (expand-context/outer? ctx_0)
(let ((inner40_0 (root-expand-context/outer-inner ctx_0)))
(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)
(if (not (begin-unsafe (expand-context/outer-name ctx_0)))
ctx_0
(if (expand-context/outer? ctx_0)
(let ((inner42_0 (root-expand-context/outer-inner ctx_0)))
(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|
as-tail-context
(lambda (wrt19_0 ctx21_0)
(begin
(if (begin-unsafe (expand-context/outer-name wrt19_0))
(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)))
(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
(lambda (ctx_0 ids_0)
(if (if (pair? ids_0) (null? (cdr ids_0)) #f)
(if (expand-context/outer? ctx_0)
(let ((name45_0 (car ids_0)))
(let ((inner46_0 (root-expand-context/outer-inner ctx_0)))
(let ((name45_1 name45_0))
(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 ((the-struct_0 (root-expand-context/outer-inner ctx_0)))
(let ((inner47_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)
#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))))
(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
(|#%call-with-values|
(lambda ()
(let ((proc_0
(lambda ()
(let ((ctx_0 (force (current-expand-context))))
(let ((phase-to-ids_0
(if ctx_0
(begin-unsafe
(expand-context/outer-need-eventually-defined
ctx_0))
#f)))
(if phase-to-ids_0
(hash-ref
phase-to-ids_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))
null)
#f))))))
(begin-unsafe (set! current-previously-unbound proc_0))))
print-values)
(void)))
(define to-syntax-list.1
(|#%name|
to-syntax-list
(lambda (s_0)
(begin
(if (list? s_0)
s_0
(if (pair? s_0)
(let ((r_0 (to-syntax-list.1 (cdr s_0))))
(if r_0 (cons (car s_0) r_0) #f))
(if (syntax?$1 s_0) (to-syntax-list.1 (syntax-e$1 s_0)) #f)))))))
(define core-scope (new-multi-scope))
(define core-stx (add-scope empty-syntax core-scope))
(define core-module-name (1/make-resolved-module-path '|#%core|))
(define core-mpi (1/module-path-index-join ''|#%core| #f))
(define cell.1$4 (unsafe-make-place-local (make-hasheq)))
(define cell.2$1 (unsafe-make-place-local (make-hasheq)))
(define core-place-init!
(lambda ()
(begin
(unsafe-place-local-set! cell.1$4 (make-hasheq))
(unsafe-place-local-set! cell.2$1 (make-hasheq)))))
(define core-id
(lambda (sym_0 phase_0)
(if (eqv? phase_0 0)
(let ((or-part_0 (hash-ref (unsafe-place-local-ref cell.1$4) sym_0 #f)))
(if or-part_0
or-part_0
(let ((s_0 (datum->syntax$1 core-stx sym_0)))
(begin
(hash-set! (unsafe-place-local-ref cell.1$4) sym_0 s_0)
s_0))))
(if (eq? phase_0 1)
(let ((or-part_0
(hash-ref (unsafe-place-local-ref cell.2$1) sym_0 #f)))
(if or-part_0
or-part_0
(let ((s_0
(datum->syntax$1
(syntax-shift-phase-level$1 core-stx 1)
sym_0)))
(begin
(hash-set! (unsafe-place-local-ref cell.2$1) sym_0 s_0)
s_0))))
(datum->syntax$1
(syntax-shift-phase-level$1 core-stx phase_0)
sym_0)))))
(define core-forms hash2610)
(define core-primitives hash2610)
(define add-core-form!*
(lambda (sym_0 proc_0)
(begin
(add-core-binding! sym_0)
(set! core-forms (hash-set core-forms sym_0 proc_0)))))
(define add-core-primitive!
(lambda (sym_0 val_0)
(begin
(add-core-binding! sym_0)
(set! core-primitives (hash-set core-primitives sym_0 val_0)))))
(define add-core-binding!
(lambda (sym_0)
(let ((temp1_0 (datum->syntax$1 core-stx sym_0)))
(let ((temp2_0
(make-module-binding.1
#f
null
#f
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
core-mpi
0
sym_0)))
(let ((temp1_1 temp1_0)) (add-binding!.1 #f #f temp1_1 temp2_0 0))))))
(define declare-core-module!
(lambda (ns_0)
(let ((temp8_0
(let ((temp14_0
(hasheqv
0
(let ((lst_0
(let ((app_0 core-primitives))
(list app_0 core-forms))))
(let ((lst_1 '(#f #t)))
(let ((lst_2 lst_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_3 lst_4)
(begin
(if (if (pair? lst_3) (pair? lst_4) #f)
(let ((syms_0 (unsafe-car lst_3)))
(let ((rest_0 (unsafe-cdr lst_3)))
(let ((syntax?_0 (unsafe-car lst_4)))
(let ((rest_1 (unsafe-cdr lst_4)))
(let ((table_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1 i_0)
(begin
(if i_0
(let ((sym_0
(hash-iterate-key
syms_0
i_0)))
(let ((table_2
(let ((table_2
(call-with-values
(lambda ()
(let ((b_0
(make-module-binding.1
#f
null
#f
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
core-mpi
0
sym_0)))
(values
sym_0
(if syntax?_0
(provided1.1
b_0
#f
#t)
b_0))))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))))
(for-loop_1
table_2
(hash-iterate-next
syms_0
i_0))))
table_1))))))
(for-loop_1
table_0
(hash-iterate-first
syms_0))))))
(for-loop_0
table_1
rest_0
rest_1))))))
table_0))))))
(for-loop_0 hash2610 lst_2 lst_1)))))))))
(let ((temp15_0
(lambda (phase-level_0 ns_1 insp_0)
(if (zero? phase-level_0)
(let ((ns_2
(namespace->module-namespace.1
#f
#f
void
ns_1
core-module-name
0)))
(if ns_2
(module-linklet-info2.1
(begin-unsafe
(definitions-variables
(namespace->definitions ns_2 0)))
#f
core-mpi
#f
#f
#f)
#f))
#f))))
(let ((temp16_0
(lambda (data-box_0
ns_1
phase_0
phase-level_0
self_0
bulk-binding-registry_0
insp_0)
(if (eq? phase-level_0 0)
(begin
(let ((ht_0 core-primitives))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value ht_0 i_0))
(case-lambda
((sym_0 val_0)
(begin
(namespace-set-consistent!
ns_1
0
sym_0
val_0)
(for-loop_0
(hash-iterate-next ht_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0)))))
(void)
(let ((ht_0 core-forms))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value ht_0 i_0))
(case-lambda
((sym_0 proc_0)
(begin
(namespace-set-transformer!
ns_1
0
sym_0
(if (procedure-arity-includes?
proc_0
2)
(core-form7.1 proc_0 sym_0)
proc_0))
(for-loop_0
(hash-iterate-next ht_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0)))))
(void))
(void)))))
(let ((temp15_1 temp15_0) (temp14_1 temp14_0))
(make-module.1
#t
void
unsafe-undefined
temp16_0
#f
0
0
#t
temp15_1
#t
void
#f
temp14_1
null
core-mpi
#f
null
#f)))))))
(declare-module!.1 #t ns_0 temp8_0 core-module-name))))
(define core-form-sym
(lambda (s_0 phase_0)
(call-with-values
(lambda ()
(if (let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0)))
(if (pair? s_1)
(if (let ((s_2 (car s_1)))
(let ((or-part_0
(if (syntax?$1 s_2)
(symbol? (syntax-e$1 s_2))
#f)))
(if or-part_0 or-part_0 (symbol? s_2))))
(let ((s_2 (cdr s_1))) #t)
#f)
#f))
(call-with-values
(lambda ()
(let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0)))
(let ((id25_0 (let ((s_2 (car s_1))) s_2)))
(let ((_0 (let ((s_2 (cdr s_1))) s_2)))
(let ((id25_1 id25_0)) (values id25_1 _0))))))
(case-lambda
((id23_0 _0) (values #t id23_0 _0))
(args (raise-binding-result-arity-error 2 args))))
(values #f #f #f)))
(case-lambda
((ok?_0 id23_0 _0)
(if ok?_0
(let ((b_0
(resolve+shift.1
#f
#f
null
unsafe-undefined
#f
id23_0
phase_0)))
(if (module-binding? b_0)
(if (eq?
core-module-name
(1/module-path-index-resolve (module-binding-module b_0)))
(module-binding-sym b_0)
#f)
#f))
#f))
(args (raise-binding-result-arity-error 3 args))))))
(define taint-dispatch
(lambda (s_0 proc_0 phase_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1 mode_0)
(begin
(if (eq? mode_0 'none)
s_1
(if (eq? mode_0 'opaque)
(|#%app| proc_0 s_1)
(if (eq? mode_0 'transparent)
(let ((c_0
(let ((s_2
(let ((or-part_0 (syntax->list$1 s_1)))
(if or-part_0 or-part_0 (syntax-e$1 s_1)))))
(let ((f_0
(|#%name|
f
(lambda (tail?_0 d_0) (begin d_0)))))
(let ((s->_0
(|#%name|
s->
(lambda (s_3)
(begin
(loop_0
s_3
(syntax-taint-mode-property
s_3)))))))
(let ((f_1 f_0) (s_3 s_2))
(let ((f_2 f_1))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0 v_0)
(begin
(if (syntax?$1 v_0)
(s->_0 v_0)
(begin-unsafe
(begin v_0))))))))
(letrec*
((loop_1
(|#%name|
loop
(lambda (tail?_0 s_4 prev-depth_0)
(begin
(let ((depth_0
(fx+ 1 prev-depth_0)))
(if (null? s_4)
(begin-unsafe (begin s_4))
(if (pair? s_4)
(let ((d_0
(let ((app_0
(loop_1
#f
(car s_4)
depth_0)))
(cons
app_0
(loop_1
1
(cdr s_4)
depth_0)))))
(begin-unsafe
(begin d_0)))
(if (symbol? s_4)
(begin-unsafe (begin s_4))
(if (boolean? s_4)
(begin-unsafe
(begin s_4))
(if (number? s_4)
(begin-unsafe
(begin s_4))
(if (let ((or-part_0
(vector?
s_4)))
(if or-part_0
or-part_0
(let ((or-part_1
(box?
s_4)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_4)))
(if or-part_2
or-part_2
(hash?
s_4)))))))
(datum-map-slow
tail?_0
s_4
(lambda (tail?_1
s_5)
(gf_0
tail?_1
s_5))
#f
#f)
(gf_0
#f
s_4)))))))))))))
(loop_1 #f s_3 0))))))))))
(datum->syntax$1
#f
c_0
s_1
(if (syntax-any-macro-scopes? s_1)
(1/syntax-property-remove s_1 original-property-sym)
s_1)))
(if (eq? mode_0 'transparent-binding)
(let ((c_0 (syntax-e$1 s_1)))
(if (pair? c_0)
(let ((cd_0 (cdr c_0)))
(if (let ((or-part_0 (pair? cd_0)))
(if or-part_0
or-part_0
(if (syntax?$1 cd_0)
(pair? (syntax-e$1 cd_0))
#f)))
(let ((d_0
(if (syntax?$1 cd_0)
(syntax-e$1 cd_0)
cd_0)))
(let ((app_0
(let ((app_0
(let ((app_0 (car c_0)))
(loop_0
app_0
(syntax-taint-mode-property
(car c_0))))))
(cons
app_0
(let ((app_1
(loop_0
(car d_0)
'transparent)))
(cons
app_1
(let ((s_2
(let ((or-part_0
(syntax->list$1
(cdr d_0))))
(if or-part_0
or-part_0
(cdr d_0)))))
(let ((f_0
(|#%name|
f
(lambda (tail?_0 d_1)
(begin d_1)))))
(let ((s->_0
(|#%name|
s->
(lambda (s_3)
(begin
(loop_0
s_3
(syntax-taint-mode-property
s_3)))))))
(let ((f_1 f_0) (s_3 s_2))
(let ((f_2 f_1))
(let ((gf_0
(|#%name|
gf
(lambda (tail?_0
v_0)
(begin
(if (syntax?$1
v_0)
(s->_0 v_0)
(begin-unsafe
(begin
v_0))))))))
(letrec*
((loop_1
(|#%name|
loop
(lambda (tail?_0
s_4
prev-depth_0)
(begin
(let ((depth_0
(fx+
1
prev-depth_0)))
(if (null?
s_4)
(begin-unsafe
(begin
s_4))
(if (pair?
s_4)
(let ((d_1
(let ((app_2
(loop_1
#f
(car
s_4)
depth_0)))
(cons
app_2
(loop_1
1
(cdr
s_4)
depth_0)))))
(begin-unsafe
(begin
d_1)))
(if (symbol?
s_4)
(begin-unsafe
(begin
s_4))
(if (boolean?
s_4)
(begin-unsafe
(begin
s_4))
(if (number?
s_4)
(begin-unsafe
(begin
s_4))
(if (let ((or-part_0
(vector?
s_4)))
(if or-part_0
or-part_0
(let ((or-part_1
(box?
s_4)))
(if or-part_1
or-part_1
(let ((or-part_2
(prefab-struct-key
s_4)))
(if or-part_2
or-part_2
(hash?
s_4)))))))
(datum-map-slow
tail?_0
s_4
(lambda (tail?_1
s_5)
(gf_0
tail?_1
s_5))
#f
#f)
(gf_0
#f
s_4)))))))))))))
(loop_1
#f
s_3
0))))))))))))))
(datum->syntax$1
#f
app_0
s_1
(if (syntax-any-macro-scopes? s_1)
(1/syntax-property-remove
s_1
original-property-sym)
s_1))))
(loop_0 s_1 'transparent)))
(loop_0 s_1 'transparent)))
(let ((c_0 (syntax-e$1 s_1)))
(let ((tmp_0 (core-form-sym c_0 phase_0)))
(if (if (eq? tmp_0 'begin)
#t
(if (eq? tmp_0 'begin-for-syntax)
#t
(eq? tmp_0 '|#%module-begin|)))
(loop_0 s_1 'transparent)
(if (if (eq? tmp_0 'define-values)
#t
(eq? tmp_0 'define-syntaxes))
(loop_0 s_1 'transparent-binding)
(loop_0 s_1 'opaque))))))))))))))
(loop_0 s_0 (syntax-taint-mode-property s_0)))))
(define syntax-taint-mode-property
(lambda (s_0)
(let ((or-part_0 (syntax-property$1 s_0 'taint-mode)))
(if or-part_0 or-part_0 (syntax-property$1 s_0 'certify-mode)))))
(define syntax-remove-taint-dispatch-properties
(lambda (s_0)
(1/syntax-property-remove
(1/syntax-property-remove s_0 'taint-mode)
'certify-mode)))
(define syntax-debug-info$1
(|#%name|
syntax-debug-info
(lambda (s_0 phase_0 all-bindings?_0)
(begin
(let ((hts_0
(reverse$1
(let ((lst_0
(fallback->list (syntax-shifted-multi-scopes s_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((smss_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((init-ht_0
(if (identifier? s_0)
(hasheq
'name
(syntax-e$1 s_0))
hash2610)))
(let ((s-scs_0
(scope-set-at-fallback
s_0
smss_0
phase_0)))
(let ((context_0
(scope-set->context
s-scs_0)))
(let ((context-ht_0
(hash-set
init-ht_0
'context
context_0)))
(let ((sym_0
(syntax-e$1
s_0)))
(let ((classify-binding_0
(|#%name|
classify-binding
(lambda (b_0)
(begin
(if (local-binding?
b_0)
'local
'module))))))
(let ((extract-binding_0
(|#%name|
extract-binding
(lambda (b_0)
(begin
(if (local-binding?
b_0)
(local-binding-key
b_0)
(let ((app_0
(module-binding-sym
b_0)))
(let ((app_1
(module-binding-module
b_0)))
(vector
app_0
app_1
(module-binding-phase
b_0))))))))))
(let ((bindings_0
(let ((app_0
(if (identifier?
s_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (bindings_0
covered-scope-sets_0
i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
s-scs_0
i_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((table_0
(scope-binding-table
sc_0)))
(if (hash?
table_0)
(values
(hash-ref
table_0
sym_0
hash2725)
null)
(values
(hash-ref
(table-with-bulk-bindings-syms
table_0)
sym_0
hash2725)
(table-with-bulk-bindings-bulk-bindings
table_0)))))
(case-lambda
((ht_0
bulk-bindings_0)
(let ((s_1
s_0))
(let ((extra-shifts_0
null))
(let ((s_2
s_1)
(ht_1
ht_0)
(bulk-bindings_1
bulk-bindings_0))
(begin
#t
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (bindings_1
covered-scope-sets_1
i_1)
(begin
(if (not
(null?
i_1))
(let ((scs_0
(if (pair?
i_1)
(bulk-binding-at-scopes
(car
i_1))
(hash-iterate-key
ht_1
i_1))))
(let ((b_0
(if (pair?
i_1)
(let ((bulk_0
(bulk-binding-at-bulk
(car
i_1))))
(let ((b-info_0
(if (symbol-interned?
sym_0)
(hash-ref
(bulk-binding-symbols
bulk_0
s_2
extra-shifts_0)
sym_0
#f)
#f)))
(if b-info_0
(|#%app|
(begin-unsafe
(bulk-binding-class-create
(bulk-binding-ref
bulk_0)))
bulk_0
b-info_0
sym_0)
#f)))
(hash-iterate-value
ht_1
i_1))))
(let ((scs_1
scs_0))
(call-with-values
(lambda ()
(if (if scs_1
(if b_0
(not
(begin-unsafe
(hash-ref
covered-scope-sets_1
scs_1
#f)))
#f)
#f)
(call-with-values
(lambda ()
(let ((app_0
(cons
(let ((app_0
(syntax-e$1
s_0)))
(let ((app_1
(scope-set->context
scs_1)))
(let ((app_2
(begin-unsafe
(hash-keys-subset?
scs_1
s-scs_0))))
(let ((app_3
(classify-binding_0
b_0)))
(hasheq
'name
app_0
'context
app_1
'match?
app_2
app_3
(extract-binding_0
b_0))))))
bindings_1)))
(values
app_0
(begin-unsafe
(hash-set
covered-scope-sets_1
scs_1
#t)))))
(case-lambda
((bindings_2
covered-scope-sets_2)
(values
bindings_2
covered-scope-sets_2))
(args
(raise-binding-result-arity-error
2
args))))
(values
bindings_1
covered-scope-sets_1)))
(case-lambda
((bindings_2
covered-scope-sets_2)
(for-loop_2
bindings_2
covered-scope-sets_2
(if (pair?
i_1)
(cdr
i_1)
(let ((or-part_0
(hash-iterate-next
ht_1
i_1)))
(if or-part_0
or-part_0
bulk-bindings_1)))))
(args
(raise-binding-result-arity-error
2
args)))))))
(values
bindings_1
covered-scope-sets_1)))))))
(for-loop_2
bindings_0
covered-scope-sets_0
(let ((or-part_0
(hash-iterate-first
ht_1)))
(if or-part_0
or-part_0
bulk-bindings_1)))))))))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((bindings_1
covered-scope-sets_1)
(for-loop_1
bindings_1
covered-scope-sets_1
(unsafe-immutable-hash-iterate-next
s-scs_0
i_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(values
bindings_0
covered-scope-sets_0)))))))
(for-loop_1
null
(set)
(unsafe-immutable-hash-iterate-first
s-scs_0)))))
(case-lambda
((bindings_0
covered-scopess_0)
bindings_0)
(args
(raise-binding-result-arity-error
2
args))))
null)))
(append
app_0
(if all-bindings?_0
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
i_0)
(begin
(if i_0
(let ((sc_0
(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)))
(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
(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)
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
(unsafe-immutable-hash-iterate-first
s-scs_0)))))
null)))))
(if (null?
bindings_0)
context-ht_0
(hash-set
context-ht_0
'bindings
bindings_0))))))))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
(let ((ht_0 (car hts_0)))
(if (null? (cdr hts_0))
ht_0
(hash-set ht_0 'fallbacks (cdr hts_0)))))))))
(define scope-set->context
(lambda (scs_0)
(let ((temp1_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key scs_0 i_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(if (interned-scope? sc_0)
(vector
(scope-id sc_0)
(scope-kind sc_0)
(interned-scope-key sc_0))
(if (representative-scope? 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
fold-var_1
(unsafe-immutable-hash-iterate-next scs_0 i_0))))
fold-var_0))))))
(for-loop_0
null
(unsafe-immutable-hash-iterate-first scs_0)))))))
(let ((temp3_0 (lambda (v_0) (vector-ref v_0 0))))
(let ((temp1_1 temp1_0)) (sort.1 #f temp3_0 temp1_1 <))))))
(define raise-ambiguous-error
(lambda (id_0 ctx_0)
(raise-syntax-error$1
#f
"identifier's binding is ambiguous"
id_0
#f
null
(syntax-debug-info-string id_0 ctx_0))))
(define syntax-debug-info-string
(lambda (s_0 ctx_0)
(let ((info_0
(syntax-debug-info$1
s_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))
#f)))
(if (not
(let ((or-part_0 (pair? (hash-ref info_0 'bindings null))))
(if or-part_0
or-part_0
(let ((lst_0 (hash-ref info_0 'fallbacks null)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((fb-info_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1
(let ((result_1
(pair?
(hash-ref
fb-info_0
'bindings
null))))
(values result_1))))
(if (if (not
(let ((x_0 (list fb-info_0)))
result_1))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #f lst_0)))))))
""
(let ((relevant-scope-sets_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (info_1 layer_0)
(begin
(let ((app_0
(let ((app_0 (hash-ref info_1 'context)))
(cons
app_0
(reverse$1
(let ((lst_0
(hash-ref info_1 'bindings null)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((b_0 (unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(hash-ref
b_0
'context)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))))
(apply
append
app_0
(let ((fallbacks_0
(hash-ref info_1 'fallbacks null)))
(reverse$1
(let ((start_0 (add1 layer_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((fallback_0
(unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(loop_0
fallback_0
pos_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
rest_0
(+ pos_0 1)))))
fold-var_0))))))
(for-loop_0
null
fallbacks_0
start_0)))))))))))))
(loop_0 info_0 0))))
(let ((common-scopes_0
(if (null? relevant-scope-sets_0)
(set)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_1 lst_0)
(begin
(if (pair? lst_0)
(let ((l_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((s_2
(let ((s_2
(set-intersect
s_1
(list->set l_0))))
(values s_2))))
(for-loop_0 s_2 rest_0))))
s_1))))))
(for-loop_0
(list->set (car relevant-scope-sets_0))
relevant-scope-sets_0))))))
(let ((app_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (info_1 layer_0)
(begin
(let ((app_0 (layer->string layer_0)))
(let ((app_1
(describe-context
(hash-ref info_1 'context)
common-scopes_0)))
(let ((app_2
(apply
string-append
(reverse$1
(let ((lst_0
(let ((temp1_0
(hash-ref
info_1
'bindings
null)))
(let ((temp2_0
(|#%name|
temp2
(lambda (a_0 b_0)
(begin
(if (hash-ref
a_0
'match?
#f)
(not
(hash-ref
b_0
'match?
#f))
#f))))))
(let ((temp1_1 temp1_0))
(sort.1
#f
#f
temp1_1
temp2_0))))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((b_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((app_2
(if (hash-ref
b_0
'match?
#f)
"matching"
"other")))
(let ((app_3
(layer->string
layer_0)))
(let ((app_4
(if (hash-ref
b_0
'local
#f)
"local"
(format
"~a"
(hash-ref
b_0
'module
#f)))))
(string-append
"\n "
app_2
" binding"
app_3
"...:"
"\n "
app_4
(describe-context
(hash-ref
b_0
'context)
common-scopes_0)))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0))))))))
(string-append
"\n context"
app_0
"...:"
app_1
app_2
(let ((fallbacks_0
(hash-ref info_1 'fallbacks null)))
(apply
string-append
(reverse$1
(let ((start_0 (add1 layer_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((fallback_0
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(loop_0
fallback_0
pos_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0
(+ pos_0 1)))))
fold-var_0))))))
(for-loop_0
null
fallbacks_0
start_0))))))))))))))))
(loop_0 info_0 0))))
(string-append
app_0
(if (begin-unsafe (zero? (hash-count common-scopes_0)))
""
(string-append
"\n common scopes...:"
(let ((app_1
(reverse$1
(let ((lst_0 (hash-ref info_0 'context)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((s_1 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(if (begin-unsafe
(hash-ref
common-scopes_0
s_1
#f))
(let ((fold-var_1
(cons
s_1
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 lst_0)))))))
(describe-context app_1 (set)))))))))))))
(define describe-context
(lambda (scopes_0 common-scopes_0)
(let ((strs_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (strs_0 scopes_1)
(begin
(if (null? scopes_1)
(reverse$1 strs_0)
(let ((str_0 (format " ~a" (car scopes_1))))
(if (if (pair? strs_0)
(<
(let ((app_0 (string-length str_0)))
(+ app_0 (string-length (car strs_0))))
72)
#f)
(let ((app_0
(let ((app_0
(string-append (car strs_0) str_0)))
(cons app_0 (cdr strs_0)))))
(loop_0 app_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
(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
string-append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((str_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(string-append "\n " str_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null strs_0)))))))))
(define layer->string
(lambda (layer_0) (if (zero? layer_0) "" (format " at layer ~a" layer_0))))
(define raise-syntax-implicit-error
(lambda (s_0 sym_0 trigger-id_0 ctx_0)
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((what_0
(if (eq? sym_0 '|#%app|)
"function application"
(if (eq? sym_0 '|#%datum|)
"literal data"
(if (eq? sym_0 '|#%top|)
(if (begin-unsafe
(expand-context/inner-allow-unbound?
(root-expand-context/outer-inner ctx_0)))
"reference to a top-level identifier"
"reference to an unbound identifier")
(void))))))
(let ((unbound?_0
(if trigger-id_0
(not (resolve.1 #f #f null #f trigger-id_0 phase_0))
#f)))
(let ((unbound-form_0
(if unbound?_0
(if (not
(let ((app_0 (syntax-e$1 s_0)))
(eq? app_0 (syntax-e$1 trigger-id_0))))
s_0
#f)
#f)))
(let ((app_0
(let ((app_0
(if unbound?_0
"unbound identifier;\n also, no ~a syntax transformer is bound~a"
(string-append
what_0
" is not allowed;\n no ~a syntax transformer is bound~a"))))
(format
app_0
sym_0
(if (eq? phase_0 0)
""
(if (eq? phase_0 1)
" in the transformer phase"
(format " at phase ~a" phase_0)))))))
(let ((app_1
(if unbound?_0
(if unbound-form_0 unbound-form_0 trigger-id_0)
#f)))
(let ((app_2
(if unbound?_0
(if unbound-form_0 trigger-id_0 #f)
s_0)))
(raise-syntax-error$1
#f
app_0
app_1
app_2
null
(if unbound?_0
(syntax-debug-info-string trigger-id_0 ctx_0)
"")))))))))))
(define make-check-no-duplicate-table (lambda () hash2610))
(define check-no-duplicate-ids.1
(|#%name|
check-no-duplicate-ids
(lambda (what1_0 ids4_0 phase5_0 s6_0 ht3_0)
(begin
(let ((ht_0
(if (eq? ht3_0 unsafe-undefined)
(make-check-no-duplicate-table)
ht3_0)))
(let ((what_0
(if (eq? what1_0 unsafe-undefined) "binding name" what1_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_0 ht_1)
(begin
(if (identifier? v_0)
(let ((l_0 (hash-ref ht_1 (syntax-e$1 v_0) null)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((id_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(if (bound-identifier=?$1
id_0
v_0
phase5_0)
(raise-syntax-error$1
#f
(string-append
"duplicate "
what_0)
s6_0
v_0)
(void))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 l_0)))
(void)
(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)))
ht_1)))))))
(loop_0 ids4_0 ht_0))))))))
(define remove-use-site-scopes
(lambda (s_0 ctx_0)
(let ((use-sites_0
(begin-unsafe (root-expand-context/outer-use-site-scopes ctx_0))))
(if (if use-sites_0 (pair? (unbox use-sites_0)) #f)
(if (syntax?$1 s_0)
(remove-scopes s_0 (unbox use-sites_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(remove-scopes
id_0
(unbox use-sites_0))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null s_0)))))
s_0))))
(define struct:compile-context
(make-record-type-descriptor*
'compile-context
#f
(|#%nongenerative-uid| compile-context)
#f
#f
7
0))
(define effect_3051
(struct-type-install-properties!
struct:compile-context
'compile-context
7
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6)
#f
'compile-context))
(define compile-context1.1
(|#%name|
compile-context
(record-constructor
(make-record-constructor-descriptor struct:compile-context #f #f))))
(define compile-context?
(|#%name| compile-context? (record-predicate struct:compile-context)))
(define compile-context-namespace
(|#%name|
compile-context-namespace
(record-accessor struct:compile-context 0)))
(define compile-context-phase
(|#%name| compile-context-phase (record-accessor struct:compile-context 1)))
(define compile-context-self
(|#%name| compile-context-self (record-accessor struct:compile-context 2)))
(define compile-context-module-self
(|#%name|
compile-context-module-self
(record-accessor struct:compile-context 3)))
(define compile-context-full-module-name
(|#%name|
compile-context-full-module-name
(record-accessor struct:compile-context 4)))
(define compile-context-lazy-syntax-literals?
(|#%name|
compile-context-lazy-syntax-literals?
(record-accessor struct:compile-context 5)))
(define compile-context-header
(|#%name| compile-context-header (record-accessor struct:compile-context 6)))
(define make-compile-context.1
(|#%name|
make-compile-context
(lambda (full-module-name6_0
lazy-syntax-literals?7_0
module-self5_0
namespace2_0
phase3_0
self4_0)
(begin
(let ((namespace_0
(if (eq? namespace2_0 unsafe-undefined)
(1/current-namespace)
namespace2_0)))
(let ((phase_0
(if (eq? phase3_0 unsafe-undefined)
(namespace-phase namespace_0)
phase3_0)))
(let ((self_0
(if (eq? self4_0 unsafe-undefined)
(begin-unsafe
(let ((v_0 (namespace-get-root-expand-ctx namespace_0)))
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner v_0)))))
self4_0)))
(let ((lazy-syntax-literals?_0
(if (eq? lazy-syntax-literals?7_0 unsafe-undefined)
(if module-self5_0 #t #f)
lazy-syntax-literals?7_0)))
(begin
(if (if module-self5_0 (not full-module-name6_0) #f)
(error
"internal error: module-self provided without full name")
(void))
(compile-context1.1
namespace_0
phase_0
self_0
module-self5_0
full-module-name6_0
lazy-syntax-literals?_0
#f))))))))))
(define kernel (primitive-table '|#%kernel|))
(define syntax?$3 (hash-ref kernel 'syntax?))
(define syntax-e$4 (hash-ref kernel 'syntax-e))
(define datum->syntax$4 (hash-ref kernel 'datum->syntax))
(define syntax->datum$4 (hash-ref kernel 'syntax->datum))
(define syntax-property$3 (hash-ref kernel 'syntax-property))
(define syntax-property-symbol-keys$3
(hash-ref kernel 'syntax-property-symbol-keys))
(define syntax-source$3 (hash-ref kernel 'syntax-source))
(define syntax-line$3 (hash-ref kernel 'syntax-line))
(define syntax-column$3 (hash-ref kernel 'syntax-column))
(define syntax-position$3 (hash-ref kernel 'syntax-position))
(define syntax-span$3 (hash-ref kernel 'syntax-span))
(define correlated?$1
(|#%name| correlated? (lambda (e_0) (begin (|#%app| syntax?$3 e_0)))))
(define datum->correlated$1
(let ((datum->correlated_0
(|#%name|
datum->correlated
(lambda (d3_0 srcloc1_0 props2_0)
(begin (|#%app| datum->syntax$4 #f d3_0 srcloc1_0 props2_0))))))
(|#%name|
datum->correlated
(case-lambda
((d_0) (begin (datum->correlated_0 d_0 #f #f)))
((d_0 srcloc_0 props2_0) (datum->correlated_0 d_0 srcloc_0 props2_0))
((d_0 srcloc1_0) (datum->correlated_0 d_0 srcloc1_0 #f))))))
(define correlated-e$1
(|#%name| correlated-e (lambda (e_0) (begin (|#%app| syntax-e$4 e_0)))))
(define correlated-property$1
(|#%name|
correlated-property
(case-lambda
((e_0 k_0) (begin (|#%app| syntax-property$3 e_0 k_0)))
((e_0 k_0 v_0) (|#%app| syntax-property$3 e_0 k_0 v_0)))))
(define correlated-property-symbol-keys$1
(|#%name|
correlated-property-symbol-keys
(lambda (e_0) (begin (|#%app| syntax-property-symbol-keys$3 e_0)))))
(define correlated-source$1
(|#%name|
correlated-source
(lambda (s_0) (begin (|#%app| syntax-source$3 s_0)))))
(define correlated-line$1
(|#%name|
correlated-line
(lambda (s_0) (begin (|#%app| syntax-line$3 s_0)))))
(define correlated-column$1
(|#%name|
correlated-column
(lambda (s_0) (begin (|#%app| syntax-column$3 s_0)))))
(define correlated-position$1
(|#%name|
correlated-position
(lambda (s_0) (begin (|#%app| syntax-position$3 s_0)))))
(define correlated-span$1
(|#%name|
correlated-span
(lambda (s_0) (begin (|#%app| syntax-span$3 s_0)))))
(define truncate-path
(lambda (p_0)
(call-with-values
(lambda () (split-path p_0))
(case-lambda
((base1_0 name1_0 dir?_0)
(if (path-for-some-system? base1_0)
(call-with-values
(lambda () (split-path base1_0))
(case-lambda
((base2_0 name2_0 dir?_1)
(if (not base2_0)
(path-for-some-system->string p_0)
(if (symbol? name2_0)
(string-append ".../" (path-elem->string name1_0))
(let ((app_0 (path-for-some-system->string name2_0)))
(string-append
".../"
app_0
"/"
(path-elem->string name1_0))))))
(args (raise-binding-result-arity-error 3 args))))
(if (eq? base1_0 'relative)
(path-elem->string name1_0)
(path-for-some-system->string p_0))))
(args (raise-binding-result-arity-error 3 args))))))
(define path-elem->string
(lambda (p_0)
(if (eq? p_0 'same)
"."
(if (eq? p_0 'up) ".." (path-for-some-system->string p_0)))))
(define path-for-some-system->string
(lambda (p_0)
(if (path? p_0)
(path->string p_0)
(bytes->string/utf-8 (path->bytes p_0) '#\xfffd))))
(define make-path->relative-path-elements.1
(|#%name|
make-path->relative-path-elements
(lambda (who1_0 wr-dir3_0)
(begin
(let ((wr-dir_0
(if (eq? wr-dir3_0 unsafe-undefined)
(current-write-relative-directory)
wr-dir3_0)))
(begin
(if who1_0
(if (let ((or-part_0 (not wr-dir_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(if (path-string? wr-dir_0)
(complete-path? wr-dir_0)
#f)))
(if or-part_1
or-part_1
(if (pair? wr-dir_0)
(if (path-string? (car wr-dir_0))
(if (complete-path? (car wr-dir_0))
(if (path-string? (cdr wr-dir_0))
(complete-path? (cdr wr-dir_0))
#f)
#f)
#f)
#f)))))
(void)
(raise-argument-error
who1_0
(string-append
"(or/c (and/c path-string? complete-path?)\n"
" (cons/c (and/c path-string? complete-path?)\n"
" (and/c path-string? complete-path?))\n"
" #f)")
wr-dir_0))
(void))
(if (not wr-dir_0)
(lambda (v_0) #f)
(let ((exploded-base-dir_0 'not-ready))
(let ((exploded-wrt-rel-dir_0 'not-ready))
(lambda (v_0)
(begin
(if (if (eq? exploded-base-dir_0 'not-ready)
(path? v_0)
#f)
(let ((wrt-dir_0
(if wr-dir_0
(if (pair? wr-dir_0) (car wr-dir_0) wr-dir_0)
#f)))
(let ((exploded-wrt-dir_0 (explode-path wrt-dir_0)))
(let ((base-dir_0
(if wr-dir_0
(if (pair? wr-dir_0)
(cdr wr-dir_0)
wr-dir_0)
#f)))
(begin
(set! exploded-base-dir_0
(if base-dir_0 (explode-path base-dir_0) #f))
(set! exploded-wrt-rel-dir_0
(if (eq? base-dir_0 wrt-dir_0)
'()
(let ((exploded-wrt-dir_1
(explode-path wrt-dir_0)))
(let ((base-len_0
(length exploded-base-dir_0)))
(begin
(if who1_0
(if (if (>=
(length exploded-wrt-dir_1)
base-len_0)
(let ((lst_0
exploded-base-dir_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0
lst_1
lst_2)
(begin
(if (if (pair?
lst_1)
(pair?
lst_2)
#f)
(let ((a_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((b_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((result_1
(let ((result_1
(equal?
a_0
b_0)))
(values
result_1))))
(if (if (not
(let ((x_0
(list
a_0)))
(not
result_1)))
(if (not
(let ((x_0
(list
b_0)))
(not
result_1)))
#t
#f)
#f)
(for-loop_0
result_1
rest_0
rest_1)
result_1))))))
result_0))))))
(for-loop_0
#t
exploded-wrt-dir_1
lst_0))))
#f)
(void)
(raise-arguments-error
who1_0
"relative-directory pair's first path does not extend second path"
"first path"
wrt-dir_0
"second path"
base-dir_0))
(void))
(list-tail
exploded-wrt-dir_1
base-len_0))))))))))
(void))
(if exploded-base-dir_0
(if (path? v_0)
(let ((exploded_0 (explode-path v_0)))
(if (let ((lst_0 exploded-base-dir_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1 lst_2)
(begin
(if (if (pair? lst_1)
(pair? lst_2)
#f)
(let ((base-p_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((p_0
(unsafe-car lst_2)))
(let ((rest_1
(unsafe-cdr lst_2)))
(let ((result_1
(let ((result_1
(equal?
base-p_0
p_0)))
(values
result_1))))
(if (if (not
(let ((x_0
(list
base-p_0)))
(not
result_1)))
(if (not
(let ((x_0
(list
p_0)))
(not
result_1)))
#t
#f)
#f)
(for-loop_0
result_1
rest_0
rest_1)
result_1))))))
result_0))))))
(for-loop_0 #t lst_0 exploded_0))))
(if (let ((app_0 (length exploded_0)))
(>= app_0 (length exploded-base-dir_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (exploded-wrt-rel-dir_1 rel_0)
(begin
(if (null? exploded-wrt-rel-dir_1)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((p_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(if (path?
p_0)
(path-element->bytes
p_0)
p_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null rel_0))))
(if (if (pair? rel_0)
(let ((app_0 (car rel_0)))
(equal?
app_0
(car
exploded-wrt-rel-dir_1)))
#f)
(let ((app_0
(cdr
exploded-wrt-rel-dir_1)))
(loop_0 app_0 (cdr rel_0)))
(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 ((p_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(cons
'up
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
exploded-wrt-rel-dir_1))))))
(append
app_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((p_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(if (path?
p_0)
(path-element->bytes
p_0)
p_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
rel_0)))))))))))))
(let ((app_0 exploded-wrt-rel-dir_0))
(loop_0
app_0
(list-tail
exploded_0
(length exploded-base-dir_0)))))
#f)
#f))
#f)
#f))))))))))))
(define 1/write-byte
(|#%name|
write-byte
(lambda (byte_0 out_0) (begin (write-byte byte_0 out_0)))))
(define 1/write-bytes
(let ((write-bytes_0
(|#%name|
write-bytes
(lambda (bstr3_0 out4_0 start-pos1_0 end-pos2_0)
(begin
(let ((end-pos_0
(if (eq? end-pos2_0 unsafe-undefined)
(unsafe-bytes-length bstr3_0)
end-pos2_0)))
(write-bytes bstr3_0 out4_0 start-pos1_0 end-pos_0)))))))
(|#%name|
write-bytes
(case-lambda
((bstr_0 out_0) (begin (write-bytes_0 bstr_0 out_0 0 unsafe-undefined)))
((bstr_0 out_0 start-pos_0 end-pos2_0)
(write-bytes_0 bstr_0 out_0 start-pos_0 end-pos2_0))
((bstr_0 out_0 start-pos1_0)
(write-bytes_0 bstr_0 out_0 start-pos1_0 unsafe-undefined))))))
(define fasl-graph-def-type 1)
(define fasl-graph-ref-type 2)
(define fasl-false-type 3)
(define fasl-true-type 4)
(define fasl-null-type 5)
(define fasl-void-type 6)
(define fasl-eof-type 7)
(define fasl-integer-type 8)
(define fasl-flonum-type 9)
(define fasl-single-flonum-type 10)
(define fasl-rational-type 11)
(define fasl-complex-type 12)
(define fasl-char-type 13)
(define fasl-symbol-type 14)
(define fasl-unreadable-symbol-type 15)
(define fasl-uninterned-symbol-type 16)
(define fasl-keyword-type 17)
(define fasl-string-type 18)
(define fasl-immutable-string-type 19)
(define fasl-bytes-type 20)
(define fasl-immutable-bytes-type 21)
(define fasl-path-type 22)
(define fasl-relative-path-type 23)
(define fasl-pregexp-type 24)
(define fasl-regexp-type 25)
(define fasl-byte-pregexp-type 26)
(define fasl-byte-regexp-type 27)
(define fasl-list-type 28)
(define fasl-list*-type 29)
(define fasl-pair-type 30)
(define fasl-vector-type 31)
(define fasl-immutable-vector-type 32)
(define fasl-box-type 33)
(define fasl-immutable-box-type 34)
(define fasl-prefab-type 35)
(define fasl-hash-type 36)
(define fasl-immutable-hash-type 37)
(define fasl-srcloc-type 38)
(define fasl-extflonum-type 39)
(define fasl-correlated-type 40)
(define fasl-undefined-type 41)
(define fasl-small-integer-start 100)
(define fasl-lowest-small-integer -10)
(define fasl-highest-small-integer 144)
(define fasl-prefix #vu8(114 97 99 107 101 116 47 102 97 115 108 58))
(define fasl-prefix-length (unsafe-bytes-length fasl-prefix))
(define fasl-hash-eq-variant 0)
(define fasl-hash-equal-variant 1)
(define fasl-hash-eqv-variant 2)
(define s-exp->fasl.1
(|#%name|
s-exp->fasl
(lambda (external-lift?7_0
handle-fail6_0
keep-mutable?5_0
skip-prefix?8_0
v14_0
orig-o13_0)
(begin
(begin
(if orig-o13_0
(if (output-port? orig-o13_0)
(void)
(raise-argument-error
's-exp->fasl
"(or/c output-port? #f)"
orig-o13_0))
(void))
(begin
(if handle-fail6_0
(if (if (procedure? handle-fail6_0)
(procedure-arity-includes? handle-fail6_0 1)
#f)
(void)
(raise-argument-error
's-exp->fasl
"(or/c (procedure-arity-includes/c 1) #f)"
handle-fail6_0))
(void))
(begin
(if external-lift?7_0
(if (if (procedure? external-lift?7_0)
(procedure-arity-includes? external-lift?7_0 1)
#f)
(void)
(raise-argument-error
's-exp->fasl
"(or/c (procedure-arity-includes/c 1) #f)"
external-lift?7_0))
(void))
(let ((o_0 (if orig-o13_0 orig-o13_0 (open-output-bytes))))
(let ((shared_0 (make-hasheq)))
(let ((external-lift_0
(if external-lift?7_0 (make-hasheq) #f)))
(let ((shared-counter_0 0))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_0)
(begin
(if (if external-lift_0
(hash-ref external-lift_0 v_0 #f)
#f)
(void)
(if (if external-lift?7_0
(|#%app| external-lift?7_0 v_0)
#f)
(begin
(hash-set! external-lift_0 v_0 #t)
(set! shared-counter_0
(add1 shared-counter_0))
(hash-set!
shared_0
v_0
(- shared-counter_0)))
(if (let ((or-part_0 (symbol? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (keyword? v_0)))
(if or-part_1
or-part_1
(let ((or-part_2 (string? v_0)))
(if or-part_2
or-part_2
(let ((or-part_3
(bytes? v_0)))
(if or-part_3
or-part_3
(path? v_0)))))))))
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
shared_0
v_0
add1
0))
(if (pair? v_0)
(begin
(loop_0 (car v_0))
(loop_0 (cdr v_0)))
(if (vector? v_0)
(begin
(call-with-values
(lambda ()
(begin
(check-vector v_0)
(values
v_0
(unsafe-vector-length v_0))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx<
pos_0
len_0)
(let ((e_0
(unsafe-vector-ref
vec_0
pos_0)))
(begin
(loop_0 e_0)
(for-loop_0
(unsafe-fx+
1
pos_0))))
(values)))))))
(for-loop_0 0))))
(args
(raise-binding-result-arity-error
2
args))))
(void))
(if (hash? v_0)
(hash-for-each
v_0
(lambda (k_0 v_1)
(begin
(loop_0 k_0)
(loop_0 v_1)))
#t)
(if (box? v_0)
(loop_0 (unbox v_0))
(let ((c1_0
(prefab-struct-key v_0)))
(if c1_0
(begin
(loop_0 c1_0)
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
(struct->vector v_0)
1
#f
1))
(case-lambda
((v*_0
start*_0
stop*_0
step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (idx_0)
(begin
(if (unsafe-fx<
idx_0
stop*_0)
(let ((e_0
(unsafe-vector-ref
v*_0
idx_0)))
(begin
(loop_0
e_0)
(for-loop_0
(unsafe-fx+
idx_0
1))))
(values)))))))
(for-loop_0
start*_0))))
(args
(raise-binding-result-arity-error
4
args))))
(void))
(if (srcloc? v_0)
(loop_0 (srcloc-source v_0))
(if (begin-unsafe
(|#%app|
syntax?$3
v_0))
(begin
(loop_0
(begin-unsafe
(|#%app|
syntax-e$4
v_0)))
(loop_0
(begin-unsafe
(|#%app|
syntax-source$3
v_0)))
(let ((lst_0
(begin-unsafe
(|#%app|
syntax-property-symbol-keys$3
v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair?
lst_1)
(let ((k_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(begin
(loop_0
k_0)
(loop_0
(begin-unsafe
(|#%app|
syntax-property$3
v_0
k_0))))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
lst_0))))
(void))
(void)))))))))))))))))
(loop_0 v14_0))
(let ((treat-immutable?_0
(|#%name|
treat-immutable?
(lambda (v_0)
(begin
(let ((or-part_0 (not keep-mutable?5_0)))
(if or-part_0
or-part_0
(immutable? v_0))))))))
(let ((path->relative-path-elements_0
(make-path->relative-path-elements.1
#f
unsafe-undefined)))
(begin
(if skip-prefix?8_0
(void)
(1/write-bytes fasl-prefix o_0))
(let ((bstr_0
(let ((o_1 (open-output-bytes)))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_0)
(begin
(if (not
(eq?
(hash-ref shared_0 v_0 1)
1))
(let ((c_0
(hash-ref
shared_0
v_0)))
(if (negative? c_0)
(begin
(begin-unsafe
(write-byte 2 o_1))
(write-fasl-integer
(sub1 (- c_0))
o_1))
(let ((pos_0
shared-counter_0))
(begin
(set! shared-counter_0
(add1
shared-counter_0))
(begin-unsafe
(write-byte 1 o_1))
(write-fasl-integer
pos_0
o_1)
(hash-remove!
shared_0
v_0)
(loop_0 v_0)
(hash-set!
shared_0
v_0
(-
(add1 pos_0)))))))
(if (not v_0)
(begin-unsafe
(write-byte 3 o_1))
(if (eq? v_0 #t)
(begin-unsafe
(write-byte 4 o_1))
(if (null? v_0)
(begin-unsafe
(write-byte 5 o_1))
(if (void? v_0)
(begin-unsafe
(write-byte 6 o_1))
(if (eof-object? v_0)
(begin-unsafe
(write-byte
7
o_1))
(if (exact-integer?
v_0)
(if (<=
-10
v_0
144)
(let ((byte_0
(+
100
(-
v_0
-10))))
(begin-unsafe
(write-byte
byte_0
o_1)))
(begin
(begin-unsafe
(write-byte
8
o_1))
(write-fasl-integer
v_0
o_1)))
(if (flonum? v_0)
(begin
(begin-unsafe
(write-byte
9
o_1))
(1/write-bytes
(if (eqv?
v_0
+nan.0)
#vu8(0 0 0 0 0 0 248 127)
(real->floating-point-bytes
v_0
8
#f))
o_1))
(if (single-flonum?
v_0)
(begin
(begin-unsafe
(write-byte
10
o_1))
(1/write-bytes
(if (eqv?
v_0
(real->single-flonum
+nan.0))
#vu8(0 0 192 127)
(real->floating-point-bytes
v_0
4
#f))
o_1))
(if (extflonum?
v_0)
(begin
(begin-unsafe
(write-byte
39
o_1))
(let ((bstr_0
(string->bytes/utf-8
(format
"~a"
v_0))))
(begin
(write-fasl-integer
(unsafe-bytes-length
bstr_0)
o_1)
(1/write-bytes
bstr_0
o_1))))
(if (rational?
v_0)
(begin
(begin-unsafe
(write-byte
11
o_1))
(loop_0
(numerator
v_0))
(loop_0
(denominator
v_0)))
(if (complex?
v_0)
(begin
(begin-unsafe
(write-byte
12
o_1))
(loop_0
(real-part
v_0))
(loop_0
(imag-part
v_0)))
(if (char?
v_0)
(begin
(begin-unsafe
(write-byte
13
o_1))
(write-fasl-integer
(char->integer
v_0)
o_1))
(if (symbol?
v_0)
(begin
(if (symbol-interned?
v_0)
(begin-unsafe
(write-byte
14
o_1))
(if (symbol-unreadable?
v_0)
(begin-unsafe
(write-byte
15
o_1))
(begin-unsafe
(write-byte
16
o_1))))
(let ((bstr_0
(string->bytes/utf-8
(symbol->string
v_0))))
(begin
(write-fasl-integer
(unsafe-bytes-length
bstr_0)
o_1)
(1/write-bytes
bstr_0
o_1))))
(if (keyword?
v_0)
(begin
(begin-unsafe
(write-byte
17
o_1))
(let ((bstr_0
(string->bytes/utf-8
(keyword->string
v_0))))
(begin
(write-fasl-integer
(unsafe-bytes-length
bstr_0)
o_1)
(1/write-bytes
bstr_0
o_1))))
(if (string?
v_0)
(begin
(write-fasl-integer
(if (treat-immutable?_0
v_0)
19
18)
o_1)
(write-fasl-string
v_0
o_1))
(if (bytes?
v_0)
(begin
(write-fasl-integer
(if (treat-immutable?_0
v_0)
21
20)
o_1)
(write-fasl-bytes
v_0
o_1))
(if (path-for-some-system?
v_0)
(let ((rel-elems_0
(|#%app|
path->relative-path-elements_0
v_0)))
(if rel-elems_0
(begin
(begin-unsafe
(write-byte
23
o_1))
(loop_0
rel-elems_0))
(begin
(begin-unsafe
(write-byte
22
o_1))
(write-fasl-bytes
(path->bytes
v_0)
o_1)
(loop_0
(path-convention-type
v_0)))))
(if (if (srcloc?
v_0)
(let ((src_0
(srcloc-source
v_0)))
(let ((or-part_0
(not
src_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(path-for-some-system?
src_0)))
(if or-part_1
or-part_1
(let ((or-part_2
(string?
src_0)))
(if or-part_2
or-part_2
(let ((or-part_3
(bytes?
src_0)))
(if or-part_3
or-part_3
(symbol?
src_0))))))))))
#f)
(let ((src_0
(srcloc-source
v_0)))
(let ((new-src_0
(if (if (path?
src_0)
(not
(|#%app|
path->relative-path-elements_0
src_0))
#f)
(truncate-path
src_0)
src_0)))
(begin
(write-fasl-integer
38
o_1)
(loop_0
new-src_0)
(loop_0
(srcloc-line
v_0))
(loop_0
(srcloc-column
v_0))
(loop_0
(srcloc-position
v_0))
(loop_0
(srcloc-span
v_0)))))
(if (pair?
v_0)
(if (pair?
(cdr
v_0))
(call-with-values
(lambda ()
(letrec*
((loop_1
(|#%name|
loop
(lambda (v_1
len_0)
(begin
(if (null?
v_1)
(values
len_0
#t)
(if (pair?
v_1)
(let ((app_0
(cdr
v_1)))
(loop_1
app_0
(add1
len_0)))
(values
len_0
#f))))))))
(loop_1
v_0
0)))
(case-lambda
((n_0
normal-list?_0)
(begin
(let ((byte_0
(if normal-list?_0
28
29)))
(begin-unsafe
(write-byte
byte_0
o_1)))
(write-fasl-integer
n_0
o_1)
(letrec*
((ploop_0
(|#%name|
ploop
(lambda (v_1)
(begin
(if (pair?
v_1)
(begin
(loop_0
(car
v_1))
(ploop_0
(cdr
v_1)))
(if normal-list?_0
(void)
(loop_0
v_1))))))))
(ploop_0
v_0))))
(args
(raise-binding-result-arity-error
2
args))))
(begin
(begin-unsafe
(write-byte
30
o_1))
(loop_0
(car
v_0))
(loop_0
(cdr
v_0))))
(if (vector?
v_0)
(begin
(let ((byte_0
(if (treat-immutable?_0
v_0)
32
31)))
(begin-unsafe
(write-byte
byte_0
o_1)))
(write-fasl-integer
(vector-length
v_0)
o_1)
(call-with-values
(lambda ()
(begin
(check-vector
v_0)
(values
v_0
(unsafe-vector-length
v_0))))
(case-lambda
((vec_0
len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx<
pos_0
len_0)
(let ((e_0
(unsafe-vector-ref
vec_0
pos_0)))
(begin
(loop_0
e_0)
(for-loop_0
(unsafe-fx+
1
pos_0))))
(values)))))))
(for-loop_0
0))))
(args
(raise-binding-result-arity-error
2
args))))
(void))
(if (box?
v_0)
(begin
(let ((byte_0
(if (treat-immutable?_0
v_0)
34
33)))
(begin-unsafe
(write-byte
byte_0
o_1)))
(loop_0
(unbox
v_0)))
(let ((c2_0
(prefab-struct-key
v_0)))
(if c2_0
(begin
(begin-unsafe
(write-byte
35
o_1))
(begin
(loop_0
c2_0)
(let ((vec_0
(struct->vector
v_0)))
(begin
(write-fasl-integer
(sub1
(vector-length
vec_0))
o_1)
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
vec_0
1
#f
1))
(case-lambda
((v*_0
start*_0
stop*_0
step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (idx_0)
(begin
(if (unsafe-fx<
idx_0
stop*_0)
(let ((e_0
(unsafe-vector-ref
v*_0
idx_0)))
(begin
(loop_0
e_0)
(for-loop_0
(unsafe-fx+
idx_0
1))))
(values)))))))
(for-loop_0
start*_0))))
(args
(raise-binding-result-arity-error
4
args))))
(void)))))
(if (hash?
v_0)
(begin
(let ((byte_0
(if (treat-immutable?_0
v_0)
37
36)))
(begin-unsafe
(write-byte
byte_0
o_1)))
(let ((byte_0
(if (hash-eq?
v_0)
0
(if (hash-eqv?
v_0)
2
1))))
(begin-unsafe
(write-byte
byte_0
o_1)))
(write-fasl-integer
(hash-count
v_0)
o_1)
(hash-for-each
v_0
(lambda (k_0
v_1)
(begin
(loop_0
k_0)
(loop_0
v_1)))
#t))
(if (regexp?
v_0)
(begin
(let ((byte_0
(if (pregexp?
v_0)
24
25)))
(begin-unsafe
(write-byte
byte_0
o_1)))
(write-fasl-string
(object-name
v_0)
o_1))
(if (byte-regexp?
v_0)
(begin
(let ((byte_0
(if (byte-pregexp?
v_0)
26
27)))
(begin-unsafe
(write-byte
byte_0
o_1)))
(write-fasl-bytes
(object-name
v_0)
o_1))
(if (begin-unsafe
(|#%app|
syntax?$3
v_0))
(begin
(begin-unsafe
(write-byte
40
o_1))
(loop_0
(begin-unsafe
(|#%app|
syntax-e$4
v_0)))
(loop_0
(let ((app_0
(begin-unsafe
(|#%app|
syntax-source$3
v_0))))
(let ((app_1
(begin-unsafe
(|#%app|
syntax-line$3
v_0))))
(let ((app_2
(begin-unsafe
(|#%app|
syntax-column$3
v_0))))
(let ((app_3
(begin-unsafe
(|#%app|
syntax-position$3
v_0))))
(unsafe-make-srcloc
app_0
app_1
app_2
app_3
(begin-unsafe
(|#%app|
syntax-span$3
v_0))))))))
(loop_0
(reverse$1
(let ((lst_0
(begin-unsafe
(|#%app|
syntax-property-symbol-keys$3
v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((k_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(cons
k_0
(begin-unsafe
(|#%app|
syntax-property$3
v_0
k_0)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
lst_0)))))))
(if (eq?
v_0
unsafe-undefined)
(begin-unsafe
(write-byte
41
o_1))
(if handle-fail6_0
(loop_0
(|#%app|
handle-fail6_0
v_0))
(raise-arguments-error
's-exp->fasl
"cannot write value"
"value"
v_0))))))))))))))))))))))))))))))))))))
(loop_0 v14_0))
(get-output-bytes o_1 #t)))))
(begin
(write-fasl-integer shared-counter_0 o_0)
(write-fasl-integer
(unsafe-bytes-length bstr_0)
o_0)
(1/write-bytes bstr_0 o_0)
(if orig-o13_0
(void)
(get-output-bytes o_0)))))))))))))))))))
(define fasl->s-exp.1
(|#%name|
fasl->s-exp
(lambda (datum-intern?16_0 external-lifts17_0 skip-prefix?18_0 orig-i22_0)
(begin
(let ((external-lifts_0
(if (eq? external-lifts17_0 unsafe-undefined)
'#()
external-lifts17_0)))
(let ((init-i_0
(if (bytes? orig-i22_0)
(mcons orig-i22_0 0)
(if (input-port? orig-i22_0)
orig-i22_0
(raise-argument-error
'fasl->s-exp
"(or/c bytes? input-port?)"
orig-i22_0)))))
(begin
(if skip-prefix?18_0
(void)
(if (bytes=?
(read-bytes/exactly* fasl-prefix-length init-i_0)
fasl-prefix)
(void)
(read-error "unrecognized prefix")))
(let ((shared-count_0 (read-fasl-integer* init-i_0)))
(let ((shared_0 (make-vector shared-count_0)))
(begin
(if (if (vector? external-lifts_0)
(<= (vector-length external-lifts_0) shared-count_0)
#f)
(void)
(error
'fasl->s-exp
"external-lift vector does not match expected size"))
(begin
(call-with-values
(lambda ()
(begin
(check-vector external-lifts_0)
(values
external-lifts_0
(unsafe-vector-length external-lifts_0))))
(case-lambda
((vec_0 len_0)
(let ((start_0 0))
(let ((vec_1 vec_0) (len_1 len_0))
(begin
#f
(void)
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0 pos_1)
(begin
(if (if (unsafe-fx< pos_0 len_1) #t #f)
(let ((v_0
(unsafe-vector-ref
vec_1
pos_0)))
(begin
(vector-set!
shared_0
pos_1
(vector-ref
external-lifts_0
pos_1))
(for-loop_0
(unsafe-fx+ 1 pos_0)
(+ pos_1 1))))
(values)))))))
(for-loop_0 0 start_0))))))
(args (raise-binding-result-arity-error 2 args))))
(let ((len_0 (read-fasl-integer* init-i_0)))
(let ((i_0
(if (mpair? init-i_0)
init-i_0
(let ((bstr_0
(read-bytes/exactly* len_0 init-i_0)))
(mcons bstr_0 0)))))
(let ((intern_0
(|#%name|
intern
(lambda (v_0)
(begin
(if datum-intern?16_0
(datum-intern-literal v_0)
v_0))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((type_0 (read-byte/no-eof i_0)))
(let ((index_0
(if (fixnum? type_0)
(if (if (unsafe-fx>= type_0 1)
(unsafe-fx< type_0 42)
#f)
(let ((tbl_0
'#(1
2
3
4
5
6
7
8
9
10
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
31
30
32
32
33
34
35
36
37
38
11
39
40)))
(unsafe-vector*-ref
tbl_0
(unsafe-fx- type_0 1)))
0)
0)))
(if (unsafe-fx< index_0 20)
(if (unsafe-fx< index_0 9)
(if (unsafe-fx< index_0 4)
(if (unsafe-fx< index_0 1)
(if (>= type_0 100)
(+ (- type_0 100) -10)
(read-error
"unrecognized fasl tag"
"tag"
type_0))
(if (unsafe-fx< index_0 2)
(let ((pos_0
(|#%app|
read-fasl-integer
i_0)))
(let ((v_0 (loop_0)))
(begin
(if (<
pos_0
shared-count_0)
(void)
(read-error
"bad graph index"))
(vector-set!
shared_0
pos_0
v_0)
v_0)))
(if (unsafe-fx< index_0 3)
(let ((pos_0
(|#%app|
read-fasl-integer
i_0)))
(begin
(if (<
pos_0
shared-count_0)
(void)
(read-error
"bad graph index"))
(vector-ref
shared_0
pos_0)))
#f)))
(if (unsafe-fx< index_0 6)
(if (unsafe-fx< index_0 5)
#t
null)
(if (unsafe-fx< index_0 7)
(void)
(if (unsafe-fx< index_0 8)
eof
(intern_0
(|#%app|
read-fasl-integer
i_0))))))
(if (unsafe-fx< index_0 14)
(if (unsafe-fx< index_0 11)
(if (unsafe-fx< index_0 10)
(floating-point-bytes->real
(read-bytes/exactly 8 i_0)
#f)
(real->single-flonum
(floating-point-bytes->real
(read-bytes/exactly 4 i_0)
#f)))
(if (unsafe-fx< index_0 12)
(let ((bstr_0
(read-bytes/exactly
(|#%app|
read-fasl-integer
i_0)
i_0)))
(let ((app_0
1/string->number))
(|#%app|
app_0
(bytes->string/utf-8
bstr_0)
10
'read)))
(if (unsafe-fx< index_0 13)
(intern_0
(let ((app_0 (loop_0)))
(/ app_0 (loop_0))))
(intern_0
(let ((app_0 (loop_0)))
(make-rectangular
app_0
(loop_0)))))))
(if (unsafe-fx< index_0 16)
(if (unsafe-fx< index_0 15)
(intern_0
(integer->char
(|#%app|
read-fasl-integer
i_0)))
(string->symbol
(|#%app|
read-fasl-string
i_0)))
(if (unsafe-fx< index_0 17)
(string->unreadable-symbol
(|#%app|
read-fasl-string
i_0))
(if (unsafe-fx< index_0 18)
(string->uninterned-symbol
(|#%app|
read-fasl-string
i_0))
(if (unsafe-fx< index_0 19)
(string->keyword
(|#%app|
read-fasl-string
i_0))
(|#%app|
read-fasl-string
i_0)))))))
(if (unsafe-fx< index_0 30)
(if (unsafe-fx< index_0 24)
(if (unsafe-fx< index_0 21)
(intern_0
(string->immutable-string
(|#%app|
read-fasl-string
i_0)))
(if (unsafe-fx< index_0 22)
(read-fasl-bytes i_0)
(if (unsafe-fx< index_0 23)
(intern_0
(bytes->immutable-bytes
(read-fasl-bytes i_0)))
(let ((app_0
(read-fasl-bytes
i_0)))
(bytes->path
app_0
(loop_0))))))
(if (unsafe-fx< index_0 26)
(if (unsafe-fx< index_0 25)
(let ((wrt-dir_0
(current-load-relative-directory)))
(let ((rel-elems_0
(reverse$1
(let ((lst_0
(loop_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((p_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(if (bytes?
p_0)
(bytes->path-element
p_0)
p_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
lst_0)))))))
(if wrt-dir_0
(apply
build-path
wrt-dir_0
rel-elems_0)
(if (null? rel-elems_0)
(build-path 'same)
(apply
build-path
rel-elems_0)))))
(intern_0
(pregexp
(|#%app|
read-fasl-string
i_0))))
(if (unsafe-fx< index_0 27)
(intern_0
(regexp
(|#%app|
read-fasl-string
i_0)))
(if (unsafe-fx< index_0 28)
(intern_0
(byte-pregexp
(read-fasl-bytes i_0)))
(if (unsafe-fx< index_0 29)
(intern_0
(byte-regexp
(read-fasl-bytes i_0)))
(let ((len_1
(|#%app|
read-fasl-integer
i_0)))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
pos_0)
(begin
(if (<
pos_0
len_1)
(let ((fold-var_1
(let ((fold-var_1
(cons
(loop_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
(+
pos_0
1)))
fold-var_0))))))
(for-loop_0
null
0))))))))))
(if (unsafe-fx< index_0 35)
(if (unsafe-fx< index_0 32)
(if (unsafe-fx< index_0 31)
(let ((app_0 (loop_0)))
(cons app_0 (loop_0)))
(let ((len_1
(|#%app|
read-fasl-integer
i_0)))
(letrec*
((ploop_0
(|#%name|
ploop
(lambda (len_2)
(begin
(if (zero? len_2)
(loop_0)
(let ((app_0
(loop_0)))
(cons
app_0
(ploop_0
(sub1
len_2))))))))))
(ploop_0 len_1))))
(if (unsafe-fx< index_0 33)
(let ((len_1
(|#%app|
read-fasl-integer
i_0)))
(let ((vec_0
(begin
(if (exact-nonnegative-integer?
len_1)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_1))
(let ((v_0
(make-vector
len_1
0)))
(begin
(if (zero?
len_1)
(void)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_1
pos_0)
(begin
(if (<
pos_0
len_1)
(let ((i_2
(let ((i_2
(begin
(unsafe-vector*-set!
v_0
i_1
(loop_0))
(unsafe-fx+
1
i_1))))
(values
i_2))))
(if (if (not
(let ((x_0
(list
pos_0)))
(unsafe-fx=
i_2
len_1)))
#t
#f)
(for-loop_0
i_2
(+
pos_0
1))
i_2))
i_1))))))
(for-loop_0
0
0))))
v_0)))))
(if (eqv? type_0 32)
(vector->immutable-vector
vec_0)
vec_0)))
(if (unsafe-fx< index_0 34)
(box (loop_0))
(box-immutable (loop_0)))))
(if (unsafe-fx< index_0 37)
(if (unsafe-fx< index_0 36)
(let ((key_0 (loop_0)))
(let ((len_1
(|#%app|
read-fasl-integer
i_0)))
(apply
make-prefab-struct
key_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
pos_0)
(begin
(if (<
pos_0
len_1)
(let ((fold-var_1
(let ((fold-var_1
(cons
(loop_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
(+
pos_0
1)))
fold-var_0))))))
(for-loop_0
null
0)))))))
(let ((ht_0
(let ((tmp_0
(read-byte/no-eof
i_0)))
(if (eq? tmp_0 0)
(make-hasheq)
(if (eq? tmp_0 2)
(make-hasheqv)
(make-hash))))))
(let ((len_1
(|#%app|
read-fasl-integer
i_0)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (<
pos_0
len_1)
(begin
(let ((app_0
(loop_0)))
(hash-set!
ht_0
app_0
(loop_0)))
(for-loop_0
(+
pos_0
1)))
(values)))))))
(for-loop_0 0)))
(void)
ht_0))))
(if (unsafe-fx< index_0 38)
(let ((ht_0
(let ((tmp_0
(read-byte/no-eof
i_0)))
(if (eq? tmp_0 0)
hash2610
(if (eq? tmp_0 2)
hash2589
hash2725)))))
(let ((len_1
(|#%app|
read-fasl-integer
i_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_1 pos_0)
(begin
(if (<
pos_0
len_1)
(let ((ht_2
(let ((ht_2
(let ((app_0
(loop_0)))
(hash-set
ht_1
app_0
(loop_0)))))
(values
ht_2))))
(for-loop_0
ht_2
(+
pos_0
1)))
ht_1))))))
(for-loop_0 ht_0 0)))))
(if (unsafe-fx< index_0 39)
(let ((app_0 (loop_0)))
(let ((app_1 (loop_0)))
(let ((app_2 (loop_0)))
(let ((app_3
(loop_0)))
(unsafe-make-srcloc
app_0
app_1
app_2
app_3
(loop_0))))))
(if (unsafe-fx< index_0 40)
(let ((e_0 (loop_0)))
(let ((s_0 (loop_0)))
(let ((c_0
(datum->correlated$1
e_0
(let ((app_0
(srcloc-source
s_0)))
(let ((app_1
(srcloc-line
s_0)))
(let ((app_2
(srcloc-column
s_0)))
(let ((app_3
(srcloc-position
s_0)))
(vector
app_0
app_1
app_2
app_3
(srcloc-span
s_0)))))))))
(let ((lst_0
(loop_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (c_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((p_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((c_2
(let ((c_2
(let ((k_0
(car
p_0)))
(let ((v_0
(cdr
p_0)))
(let ((k_1
k_0))
(begin-unsafe
(|#%app|
syntax-property$3
c_1
k_1
v_0)))))))
(values
c_2))))
(for-loop_0
c_2
rest_0))))
c_1))))))
(for-loop_0
c_0
lst_0)))))))
unsafe-undefined))))))))))))))
(loop_0))))))))))))))))
(define write-fasl-integer
(lambda (i_0 o_0)
(if (<= -124 i_0 127)
(if (negative? i_0)
(let ((byte_0 (+ i_0 256))) (begin-unsafe (write-byte byte_0 o_0)))
(begin-unsafe (write-byte i_0 o_0)))
(if (<= -32768 i_0 32767)
(begin
(begin-unsafe (write-byte 128 o_0))
(1/write-bytes (integer->integer-bytes i_0 2 #t #f) o_0))
(if (<= -2147483648 i_0 2147483647)
(begin
(begin-unsafe (write-byte 129 o_0))
(1/write-bytes (integer->integer-bytes i_0 4 #t #f) o_0))
(if (<= -9223372036854775808 i_0 9223372036854775807)
(begin
(begin-unsafe (write-byte 130 o_0))
(1/write-bytes (integer->integer-bytes i_0 8 #t #f) o_0))
(begin
(begin-unsafe (write-byte 131 o_0))
(let ((s_0 (format "~x" i_0)))
(begin
(write-fasl-integer (string-length s_0) o_0)
(write-string s_0 o_0))))))))))
(define write-fasl-string
(lambda (v_0 o_0)
(let ((bstr_0 (string->bytes/utf-8 v_0)))
(begin
(write-fasl-integer (unsafe-bytes-length bstr_0) o_0)
(1/write-bytes bstr_0 o_0)))))
(define write-fasl-bytes
(lambda (v_0 o_0)
(begin
(write-fasl-integer (unsafe-bytes-length v_0) o_0)
(1/write-bytes v_0 o_0))))
(define read-error
(lambda (s_0 . args_0)
(apply
raise-arguments-error
'fasl-read
(string-append "error parsing fasl stream;\n" " " s_0)
args_0)))
(define read-byte/no-eof
(lambda (i_0)
(let ((pos_0 (unsafe-mcdr i_0)))
(begin
(if (fx< pos_0 (unsafe-bytes-length (unsafe-mcar i_0)))
(void)
(read-error "truncated stream"))
(unsafe-set-mcdr! i_0 (fx+ pos_0 1))
(unsafe-bytes-ref (unsafe-mcar i_0) pos_0)))))
(define read-byte/no-eof*
(lambda (i_0)
(if (mpair? i_0)
(read-byte/no-eof i_0)
(let ((b_0 (read-byte i_0)))
(begin
(if (eof-object? b_0) (read-error "truncated stream") (void))
b_0)))))
(define read-bytes/exactly
(lambda (n_0 i_0)
(let ((pos_0 (unsafe-mcdr i_0)))
(begin
(if (let ((app_0 (+ pos_0 n_0)))
(<= app_0 (unsafe-bytes-length (unsafe-mcar i_0))))
(void)
(read-error "truncated stream"))
(unsafe-set-mcdr! i_0 (fx+ pos_0 n_0))
(let ((app_0 (unsafe-mcar i_0)))
(subbytes app_0 pos_0 (fx+ pos_0 n_0)))))))
(define read-bytes/exactly*
(lambda (n_0 i_0)
(if (mpair? i_0)
(read-bytes/exactly n_0 i_0)
(let ((bstr_0 (read-bytes n_0 i_0)))
(begin
(if (if (bytes? bstr_0) (= n_0 (unsafe-bytes-length bstr_0)) #f)
(void)
(read-error "truncated stream"))
bstr_0)))))
(define read-fasl-integer
(lambda (i_0)
(let ((b_0 (read-byte/no-eof i_0)))
(if (fx<= b_0 127)
b_0
(if (fx>= b_0 132)
(fx- b_0 256)
(if (eqv? b_0 128)
(let ((lo_0 (read-byte/no-eof i_0)))
(let ((hi_0 (read-byte/no-eof i_0)))
(if (fx> hi_0 127)
(fxior (fxlshift (fx+ -256 hi_0) 8) lo_0)
(fxior (fxlshift hi_0 8) lo_0))))
(if (eqv? b_0 129)
(let ((a_0 (read-byte/no-eof i_0)))
(let ((b_1 (read-byte/no-eof i_0)))
(let ((c_0 (read-byte/no-eof i_0)))
(let ((d_0 (read-byte/no-eof i_0)))
(bitwise-ior
a_0
(arithmetic-shift
(if (fx> d_0 127)
(let ((app_0 (fxlshift (fx+ -256 d_0) 16)))
(fxior app_0 (fxlshift c_0 8) b_1))
(let ((app_0 (fxlshift d_0 16)))
(fxior app_0 (fxlshift c_0 8) b_1)))
8))))))
(if (eqv? b_0 130)
(integer-bytes->integer (read-bytes/exactly 8 i_0) #t #f)
(if (eqv? b_0 131)
(let ((len_0 (|#%app| read-fasl-integer i_0)))
(let ((str_0 (|#%app| read-fasl-string i_0 len_0)))
(begin
(if (if (string? str_0)
(= len_0 (string-length str_0))
#f)
(void)
(read-error "truncated stream at number"))
(|#%app| 1/string->number str_0 16))))
(read-error "internal error on integer mode"))))))))))
(define read-fasl-integer*
(lambda (i_0)
(let ((b_0 (read-byte/no-eof* i_0)))
(if (fx<= b_0 127)
b_0
(if (fx>= b_0 132)
(fx- b_0 256)
(if (eqv? b_0 128)
(let ((lo_0 (read-byte/no-eof* i_0)))
(let ((hi_0 (read-byte/no-eof* i_0)))
(if (fx> hi_0 127)
(fxior (fxlshift (fx+ -256 hi_0) 8) lo_0)
(fxior (fxlshift hi_0 8) lo_0))))
(if (eqv? b_0 129)
(let ((a_0 (read-byte/no-eof* i_0)))
(let ((b_1 (read-byte/no-eof* i_0)))
(let ((c_0 (read-byte/no-eof* i_0)))
(let ((d_0 (read-byte/no-eof* i_0)))
(bitwise-ior
a_0
(arithmetic-shift
(if (fx> d_0 127)
(let ((app_0 (fxlshift (fx+ -256 d_0) 16)))
(fxior app_0 (fxlshift c_0 8) b_1))
(let ((app_0 (fxlshift d_0 16)))
(fxior app_0 (fxlshift c_0 8) b_1)))
8))))))
(if (eqv? b_0 130)
(integer-bytes->integer (read-bytes/exactly* 8 i_0) #t #f)
(if (eqv? b_0 131)
(let ((len_0 (|#%app| read-fasl-integer i_0)))
(let ((str_0 (|#%app| read-fasl-string i_0 len_0)))
(begin
(if (if (string? str_0)
(= len_0 (string-length str_0))
#f)
(void)
(read-error "truncated stream at number"))
(|#%app| 1/string->number str_0 16))))
(read-error "internal error on integer mode"))))))))))
(define read-fasl-string
(let ((read-fasl-string_0
(|#%name|
read-fasl-string
(lambda (i25_0 len24_0)
(begin
(let ((len_0
(if (eq? len24_0 unsafe-undefined)
(|#%app| read-fasl-integer i25_0)
len24_0)))
(let ((pos_0 (unsafe-mcdr i25_0)))
(let ((bstr_0 (unsafe-mcar i25_0)))
(if (<= (+ pos_0 len_0) (unsafe-bytes-length bstr_0))
(begin
(unsafe-set-mcdr! i25_0 (fx+ pos_0 len_0))
(let ((s_0 (make-string len_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0)
(begin
(if (fx= i_0 len_0)
s_0
(let ((c_0
(unsafe-bytes-ref
bstr_0
(fx+ i_0 pos_0))))
(if (fx<= c_0 128)
(begin
(string-set!
s_0
i_0
(integer->char c_0))
(loop_0 (fx+ i_0 1)))
(bytes->string/utf-8
bstr_0
#f
pos_0
(fx+ pos_0 len_0))))))))))
(loop_0 0))))
(let ((bstr_1 (read-bytes/exactly len_0 i25_0)))
(bytes->string/utf-8 bstr_1)))))))))))
(case-lambda
((i_0) (read-fasl-string_0 i_0 unsafe-undefined))
((i_0 len24_0) (read-fasl-string_0 i_0 len24_0)))))
(define read-fasl-bytes
(lambda (i_0)
(let ((len_0 (|#%app| read-fasl-integer i_0)))
(read-bytes/exactly len_0 i_0))))
(define struct:mpi-intern-table
(make-record-type-descriptor*
'mpi-intern-table
#f
(|#%nongenerative-uid| mpi-intern-table)
#f
#f
2
0))
(define effect_2419
(struct-type-install-properties!
struct:mpi-intern-table
'mpi-intern-table
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'mpi-intern-table))
(define mpi-intern-table1.1
(|#%name|
mpi-intern-table
(record-constructor
(make-record-constructor-descriptor struct:mpi-intern-table #f #f))))
(define mpi-intern-table?_2949
(|#%name| mpi-intern-table? (record-predicate struct:mpi-intern-table)))
(define mpi-intern-table?
(|#%name|
mpi-intern-table?
(lambda (v)
(if (mpi-intern-table?_2949 v)
#t
($value
(if (impersonator? v)
(mpi-intern-table?_2949 (impersonator-val v))
#f))))))
(define mpi-intern-table-normal_2774
(|#%name|
mpi-intern-table-normal
(record-accessor struct:mpi-intern-table 0)))
(define mpi-intern-table-normal
(|#%name|
mpi-intern-table-normal
(lambda (s)
(if (mpi-intern-table?_2949 s)
(mpi-intern-table-normal_2774 s)
($value
(impersonate-ref
mpi-intern-table-normal_2774
struct:mpi-intern-table
0
s
'mpi-intern-table
'normal))))))
(define mpi-intern-table-fast_2301
(|#%name| mpi-intern-table-fast (record-accessor struct:mpi-intern-table 1)))
(define mpi-intern-table-fast
(|#%name|
mpi-intern-table-fast
(lambda (s)
(if (mpi-intern-table?_2949 s)
(mpi-intern-table-fast_2301 s)
($value
(impersonate-ref
mpi-intern-table-fast_2301
struct:mpi-intern-table
1
s
'mpi-intern-table
'fast))))))
(define make-module-path-index-intern-table
(lambda ()
(let ((app_0 (make-hash))) (mpi-intern-table1.1 app_0 (make-hasheq)))))
(define intern-module-path-index!
(lambda (t_0 mpi_0)
(let ((or-part_0 (hash-ref (mpi-intern-table-fast t_0) mpi_0 #f)))
(if or-part_0
or-part_0
(call-with-values
(lambda () (1/module-path-index-split mpi_0))
(case-lambda
((name_0 base_0)
(if (not name_0)
(begin (hash-set! (mpi-intern-table-fast t_0) mpi_0 mpi_0) mpi_0)
(let ((interned-base_0
(if base_0 (intern-module-path-index! t_0 base_0) #f)))
(let ((at-name_0
(let ((or-part_1
(hash-ref
(mpi-intern-table-normal t_0)
name_0
#f)))
(if or-part_1
or-part_1
(let ((at-name_0 (make-hasheq)))
(begin
(hash-set!
(mpi-intern-table-normal t_0)
name_0
at-name_0)
at-name_0))))))
(let ((i-mpi_0
(let ((or-part_1
(hash-ref at-name_0 interned-base_0 #f)))
(if or-part_1
or-part_1
(let ((mpi_1
(if (eq? base_0 interned-base_0)
mpi_0
(if (1/module-path-index? mpi_0)
(let ((app_0
(module-path-index-resolved
mpi_0)))
(module-path-index2.1
(module-path-index-path mpi_0)
interned-base_0
app_0
(module-path-index-shift-cache
mpi_0)))
(raise-argument-error
'struct-copy
"module-path-index?"
mpi_0)))))
(begin
(hash-set! at-name_0 interned-base_0 mpi_1)
mpi_1))))))
(begin
(hash-set! (mpi-intern-table-fast t_0) mpi_0 i-mpi_0)
i-mpi_0))))))
(args (raise-binding-result-arity-error 2 args))))))))
(define built-in-symbols (make-hasheq))
(define register-built-in-symbol!
(lambda (s_0) (hash-set! built-in-symbols s_0 #t)))
(define built-in-symbol? (lambda (s_0) (hash-ref built-in-symbols s_0 #f)))
(define make-built-in-symbol!
(lambda (s_0)
(let ((built-in-s_0 (string->symbol (format ".~s" s_0))))
(begin
(begin-unsafe (hash-set! built-in-symbols built-in-s_0 #t))
built-in-s_0))))
(define effect_2323
(begin
(void
(begin
(for-each_2380
register-built-in-symbol!
'(lambda case-lambda
if
begin
begin0
let-values
letrec-values
set!
quote
with-continuation-mark
|#%variable-reference|))
(for-each_2380
register-built-in-symbol!
'(check-not-undefined
instance-variable-box
variable-reference
variable-reference?
variable-reference->instance
variable-reference-constant?
variable-reference-from-unsafe?))
(for-each_2380
register-built-in-symbol!
'(or and
let
letrec*
define
$value
with-continuation-mark*
pariah
begin-unsafe
variable-set!
variable-ref
variable-ref/no-check
variable-set!/check-undefined
variable-set!/define
make-instance-variable-reference
instance-variable-reference
unbox/check-undefined
set-box!/check-undefined
annotation?
annotation-expression
|#%app|
|#%call-with-values|
|#%app/no-return|
|#%app/value|
call-with-module-prompt
make-pthread-parameter
engine-block
make-record-type-descriptor
make-record-type-descriptor*
make-record-constructor-descriptor
record-constructor
record-accessor
record-mutator
record-predicate
struct-type-install-properties!
|#%struct-constructor|
|#%struct-predicate|
|#%struct-field-accessor|
|#%struct-field-mutator|
|#%nongenerative-uid|
unsafe-struct?
unsafe-struct
raise-binding-result-arity-error
raise-definition-result-arity-error
structure-type-lookup-prefab-uid
struct-type-constructor-add-guards
impersonator-val
impersonator-ref
impersonate-set!
ptr-ref/int8
ptr-set!/int8
ptr-ref/uint8
ptr-set!/uint8
ptr-ref/int16
ptr-set!/int16
ptr-ref/uint16
ptr-set!/uint16
ptr-ref/int32
ptr-set!/int32
ptr-ref/uint32
ptr-set!/uint32
ptr-ref/int64
ptr-set!/int64
ptr-ref/uint64
ptr-set!/uint64
ptr-ref/double
ptr-set!/double
ptr-ref/float
ptr-set!/float))))
(void)))
(define phase-shift-id (make-built-in-symbol! 'phase))
(define dest-phase-id (make-built-in-symbol! 'dest-phase))
(define ns-id (make-built-in-symbol! 'namespace))
(define self-id (make-built-in-symbol! 'self))
(define syntax-literals-id (make-built-in-symbol! 'syntax-literals))
(define get-syntax-literal!-id (make-built-in-symbol! 'get-syntax-literal!))
(define bulk-binding-registry-id
(make-built-in-symbol! 'bulk-binding-registry))
(define inspector-id (make-built-in-symbol! 'inspector))
(define deserialize-syntax-id (make-built-in-symbol! 'deserialize-syntax))
(define deserialized-syntax-vector-id
(make-built-in-symbol! 'deserialized-syntax-vector))
(define set-transformer!-id (make-built-in-symbol! 'set-transformer!))
(define top-level-bind!-id (make-built-in-symbol! 'top-level-bind!))
(define top-level-require!-id (make-built-in-symbol! 'top-level-require!))
(define mpi-vector-id (make-built-in-symbol! 'mpi-vector))
(define struct:module-path-index-table
(make-record-type-descriptor*
'module-path-index-table
#f
(|#%nongenerative-uid| module-path-index-table)
#f
#f
2
0))
(define effect_2891
(struct-type-install-properties!
struct:module-path-index-table
'module-path-index-table
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'module-path-index-table))
(define module-path-index-table1.1
(|#%name|
module-path-index-table
(record-constructor
(make-record-constructor-descriptor
struct:module-path-index-table
#f
#f))))
(define module-path-index-table?_2552
(|#%name|
module-path-index-table?
(record-predicate struct:module-path-index-table)))
(define module-path-index-table?
(|#%name|
module-path-index-table?
(lambda (v)
(if (module-path-index-table?_2552 v)
#t
($value
(if (impersonator? v)
(module-path-index-table?_2552 (impersonator-val v))
#f))))))
(define module-path-index-table-positions_2549
(|#%name|
module-path-index-table-positions
(record-accessor struct:module-path-index-table 0)))
(define module-path-index-table-positions
(|#%name|
module-path-index-table-positions
(lambda (s)
(if (module-path-index-table?_2552 s)
(module-path-index-table-positions_2549 s)
($value
(impersonate-ref
module-path-index-table-positions_2549
struct:module-path-index-table
0
s
'module-path-index-table
'positions))))))
(define module-path-index-table-intern_2630
(|#%name|
module-path-index-table-intern
(record-accessor struct:module-path-index-table 1)))
(define module-path-index-table-intern
(|#%name|
module-path-index-table-intern
(lambda (s)
(if (module-path-index-table?_2552 s)
(module-path-index-table-intern_2630 s)
($value
(impersonate-ref
module-path-index-table-intern_2630
struct:module-path-index-table
1
s
'module-path-index-table
'intern))))))
(define make-module-path-index-table
(lambda ()
(let ((app_0 (make-hasheq)))
(module-path-index-table1.1
app_0
(make-module-path-index-intern-table)))))
(define add-module-path-index!
(lambda (mpis_0 mpi_0)
(let ((pos_0 (add-module-path-index!/pos mpis_0 mpi_0)))
(if pos_0 (list 'unsafe-vector*-ref mpi-vector-id pos_0) #f))))
(define add-module-path-index!/pos
(lambda (mpis_0 mpi_0)
(if (not mpi_0)
#f
(if mpi_0
(let ((mpi_1
(intern-module-path-index!
(module-path-index-table-intern mpis_0)
mpi_0)))
(let ((positions_0 (module-path-index-table-positions mpis_0)))
(let ((mpi_2 mpi_1))
(let ((or-part_0 (hash-ref positions_0 mpi_2 #f)))
(if or-part_0
or-part_0
(let ((pos_0 (hash-count positions_0)))
(begin (hash-set! positions_0 mpi_2 pos_0) pos_0)))))))
(void)))))
(define generate-module-path-index-deserialize
(lambda (mpis_0)
(let ((unique-list_0
(|#%name|
unique-list
(lambda (v_0)
(begin
(if (pair? v_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((i_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1 (cons i_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 v_0))))
v_0))))))
(let ((positions_0 (module-path-index-table-positions mpis_0)))
(let ((gen-order_0 (make-hasheqv)))
(let ((rev-positions_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value positions_0 i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values v_0 k_0))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next positions_0 i_0))))
(args
(raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0
hash2589
(hash-iterate-first positions_0))))))
(begin
(let ((end_0 (hash-count rev-positions_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (< pos_0 end_0)
(begin
(let ((mpi_0 (hash-ref rev-positions_0 pos_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (mpi_1)
(begin
(if (hash-ref gen-order_0 mpi_1 #f)
(void)
(call-with-values
(lambda ()
(1/module-path-index-split mpi_1))
(case-lambda
((name_0 base_0)
(begin
(if base_0
(loop_0 base_0)
(void))
(hash-set!
gen-order_0
mpi_1
(hash-count gen-order_0))))
(args
(raise-binding-result-arity-error
2
args))))))))))
(loop_0 mpi_0)))
(for-loop_0 (+ pos_0 1)))
(values)))))))
(for-loop_0 0))))
(let ((rev-gen-order_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value gen-order_0 i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values v_0 k_0))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next gen-order_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2589
(hash-iterate-first gen-order_0))))))
(let ((gens_0
(let ((len_0 (hash-count gen-order_0)))
(begin
(if (exact-nonnegative-integer? len_0)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_0))
(let ((v_0 (make-vector len_0 0)))
(begin
(if (zero? len_0)
(void)
(let ((end_0 (hash-count gen-order_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((i_1 i_0))
(let ((i_2
(let ((i_2
(begin
(let ((app_0
i_1))
(unsafe-vector*-set!
v_0
app_0
(let ((mpi_0
(hash-ref
rev-gen-order_0
pos_0)))
(call-with-values
(lambda ()
(1/module-path-index-split
mpi_0))
(case-lambda
((path_0
base_0)
(if (begin-unsafe
(eq?
top-level-module-path-index
mpi_0))
'top
(if (not
path_0)
(box
(let ((or-part_0
(unique-list_0
(1/resolved-module-path-name
(module-path-index-resolved
mpi_0)))))
(if or-part_0
or-part_0
'self)))
(if (not
base_0)
(vector
path_0)
(if base_0
(vector
path_0
(hash-ref
gen-order_0
base_0))
(void))))))
(args
(raise-binding-result-arity-error
2
args)))))))
(unsafe-fx+
1
i_1))))
(values i_2))))
(if (if (not
(let ((x_0
(list
pos_0)))
(unsafe-fx=
i_2
len_0)))
#t
#f)
(for-loop_0
i_2
(+ pos_0 1))
i_2)))
i_0))))))
(for-loop_0 0 0)))))
v_0))))))
(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)))
(begin
(call-with-values
(lambda ()
(begin
(check-vector gen-vec_0)
(values gen-vec_0 (unsafe-vector-length gen-vec_0))))
(case-lambda
((vec_0 len_0)
(let ((start_0 0))
(let ((vec_1 vec_0) (len_1 len_0))
(begin
#f
(void)
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0 pos_1)
(begin
(if (if (unsafe-fx< pos_0 len_1) #t #f)
(let ((d_0 (unsafe-vector-ref vec_1 pos_0)))
(begin
(vector-set!
gen_0
pos_1
(if (eq? d_0 'top)
(begin-unsafe top-level-module-path-index)
(if (box? d_0)
(let ((name_0 (unbox d_0)))
(begin-unsafe
(make-self-module-path-index
(1/make-resolved-module-path name_0))))
(let ((path_0 (unsafe-vector*-ref d_0 0)))
(let ((base_0
(if (>
(unsafe-vector*-length d_0)
1)
(unsafe-vector*-ref
gen_0
(unsafe-vector*-ref d_0 1))
#f)))
(let ((path_1 path_0))
(begin-unsafe
(1/module-path-index-join
path_1
base_0))))))))
(for-loop_0 (unsafe-fx+ 1 pos_0) (+ pos_1 1))))
(values)))))))
(for-loop_0 0 start_0))))))
(args (raise-binding-result-arity-error 2 args))))
(void)
(let ((len_0 (vector-length order-vec_0)))
(begin
(if (exact-nonnegative-integer? len_0)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_0))
(let ((v_0 (make-vector len_0 0)))
(begin
(if (zero? len_0)
(void)
(call-with-values
(lambda ()
(begin
(check-vector order-vec_0)
(values
order-vec_0
(unsafe-vector-length order-vec_0))))
(case-lambda
((vec_0 len_1)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_1)
(let ((p_0 (unsafe-vector-ref vec_0 pos_0)))
(let ((i_1
(let ((i_1
(begin
(unsafe-vector*-set!
v_0
i_0
(unsafe-vector*-ref
gen_0
p_0))
(unsafe-fx+ 1 i_0))))
(values i_1))))
(if (if (not
(let ((x_0 (list p_0)))
(unsafe-fx= i_1 len_0)))
#t
#f)
(for-loop_0 i_1 (unsafe-fx+ 1 pos_0))
i_1)))
i_0))))))
(for-loop_0 0 0))))
(args (raise-binding-result-arity-error 2 args)))))
v_0))))))))
(define mpis-as-vector
(lambda (mpis_0)
(let ((positions_0 (module-path-index-table-positions mpis_0)))
(let ((vec_0 (make-vector (hash-count positions_0) #f)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value positions_0 i_0))
(case-lambda
((mpi_0 pos_0)
(begin
(vector-set! vec_0 pos_0 mpi_0)
(for-loop_0 (hash-iterate-next positions_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (hash-iterate-first positions_0))))
(void)
vec_0)))))
(define generate-module-data-linklet
(lambda (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 deserialize-imports (list mpi-vector-id))))
(let ((app_1
(list
'define-values
'(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
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(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
(add-module-path-index!
mpis_0
(module-use-module mu_0))))
(list
'module-use
app_0
(module-use-phase mu_0)))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null mus_0))))))
(define interned-literal?
(lambda (v_0)
(let ((or-part_0 (null? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (boolean? v_0)))
(if or-part_1
or-part_1
(let ((or-part_2
(if (fixnum? v_0)
(if (< v_0 1073741823) (> v_0 -1073741824) #f)
#f)))
(if or-part_2
or-part_2
(let ((or-part_3 (symbol? v_0)))
(if or-part_3
or-part_3
(let ((or-part_4 (char? v_0)))
(if or-part_4 or-part_4 (keyword? v_0)))))))))))))
(define serialize-phase-to-link-module-uses
(lambda (phase-to-link-module-uses_0 mpis_0)
(let ((phases-in-order_0
(let ((temp14_0 (hash-keys phase-to-link-module-uses_0)))
(sort.1 #f #f temp14_0 <))))
(list*
'hasheqv
(apply
append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((phase_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(list
phase_0
(list*
'list
(serialize-module-uses
(hash-ref
phase-to-link-module-uses_0
phase_0)
mpis_0)))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null phases-in-order_0)))))))))
(define generate-deserialize.1
(|#%name|
generate-deserialize
(lambda (syntax-support?2_0 v4_0 mpis5_0)
(begin
(let ((reachable-scopes_0 (find-reachable-scopes v4_0)))
(let ((state_0 (make-serialize-state reachable-scopes_0)))
(let ((mutables_0 (make-hasheq)))
(let ((objs_0 (make-hasheq)))
(let ((shares_0 (make-hasheq)))
(let ((obj-step_0 0))
(let ((frontier_0 null))
(letrec*
((add-frontier!_0
(|#%name|
add-frontier!
(case-lambda
((v_0)
(begin (set! frontier_0 (cons v_0 frontier_0))))
((kind_0 v_0) (add-frontier!_0 v_0))))))
(begin
(letrec*
((frontier-loop_0
(|#%name|
frontier-loop
(lambda (v_0)
(begin
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_1)
(begin
(if (let ((or-part_0
(interned-literal? v_1)))
(if or-part_0
or-part_0
(1/module-path-index? v_1)))
(void)
(if (hash-ref objs_0 v_1 #f)
(if (hash-ref mutables_0 v_1 #f)
(void)
(hash-set! shares_0 v_1 #t))
(begin
(if (serialize-fill!? v_1)
(begin
(hash-set!
mutables_0
v_1
(hash-count mutables_0))
(|#%app|
(serialize-fill!-ref v_1)
v_1
add-frontier!_0
state_0))
(if (serialize? v_1)
(|#%app|
(serialize-ref v_1)
v_1
(case-lambda
((sub-v_0)
(loop_0 sub-v_0))
((kind_0 sub-v_0)
(loop_0 sub-v_0)))
state_0)
(if (pair? v_1)
(begin
(loop_0 (car v_1))
(loop_0 (cdr v_1)))
(if (vector? v_1)
(if (let ((or-part_0
(immutable?
v_1)))
(if or-part_0
or-part_0
(zero?
(vector-length
v_1))))
(begin
(call-with-values
(lambda ()
(begin
(check-vector
v_1)
(values
v_1
(unsafe-vector-length
v_1))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx<
pos_0
len_0)
(let ((e_0
(unsafe-vector-ref
vec_0
pos_0)))
(begin
(loop_0
e_0)
(for-loop_0
(unsafe-fx+
1
pos_0))))
(values)))))))
(for-loop_0
0))))
(args
(raise-binding-result-arity-error
2
args))))
(void))
(begin
(hash-set!
mutables_0
v_1
(hash-count
mutables_0))
(begin
(call-with-values
(lambda ()
(begin
(check-vector
v_1)
(values
v_1
(unsafe-vector-length
v_1))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx<
pos_0
len_0)
(let ((e_0
(unsafe-vector-ref
vec_0
pos_0)))
(begin
(add-frontier!_0
e_0)
(for-loop_0
(unsafe-fx+
1
pos_0))))
(values)))))))
(for-loop_0
0))))
(args
(raise-binding-result-arity-error
2
args))))
(void))))
(if (box? v_1)
(if (immutable? v_1)
(loop_0
(unbox v_1))
(begin
(hash-set!
mutables_0
v_1
(hash-count
mutables_0))
(add-frontier!_0
(unbox v_1))))
(if (hash? v_1)
(if (immutable?
v_1)
(begin
(let ((lst_0
(sorted-hash-keys
v_1)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair?
lst_1)
(let ((k_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(begin
(loop_0
k_0)
(loop_0
(hash-ref
v_1
k_0)))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
lst_0))))
(void))
(begin
(hash-set!
mutables_0
v_1
(hash-count
mutables_0))
(begin
(let ((lst_0
(sorted-hash-keys
v_1)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair?
lst_1)
(let ((k_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(begin
(add-frontier!_0
k_0)
(add-frontier!_0
(hash-ref
v_1
k_0)))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
lst_0))))
(void))))
(if (prefab-struct-key
v_1)
(begin
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
(struct->vector
v_1)
1
#f
1))
(case-lambda
((v*_0
start*_0
stop*_0
step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (idx_0)
(begin
(if (unsafe-fx<
idx_0
stop*_0)
(let ((e_0
(unsafe-vector-ref
v*_0
idx_0)))
(begin
(loop_0
e_0)
(for-loop_0
(unsafe-fx+
idx_0
1))))
(values)))))))
(for-loop_0
start*_0))))
(args
(raise-binding-result-arity-error
4
args))))
(void))
(if (srcloc? v_1)
(if (path?
(srcloc-source
v_1))
(void)
(begin
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
(struct->vector
v_1)
1
#f
1))
(case-lambda
((v*_0
start*_0
stop*_0
step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (idx_0)
(begin
(if (unsafe-fx<
idx_0
stop*_0)
(let ((e_0
(unsafe-vector-ref
v*_0
idx_0)))
(begin
(loop_0
e_0)
(for-loop_0
(unsafe-fx+
idx_0
1))))
(values)))))))
(for-loop_0
start*_0))))
(args
(raise-binding-result-arity-error
4
args))))
(void)))
(void)))))))))
(hash-set!
objs_0
v_1
obj-step_0)
(set! obj-step_0
(add1 obj-step_0))))))))))
(loop_0 v_0))
(if (null? frontier_0)
(void)
(let ((l_0 frontier_0))
(begin
(set! frontier_0 null)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((v_1
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(frontier-loop_0 v_1)
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0 l_0)))
(void))))))))))
(frontier-loop_0 v4_0))
(let ((num-mutables_0 (hash-count mutables_0)))
(let ((share-step-positions_0
(let ((share-steps_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 i_0)
(begin
(if i_0
(let ((obj_0
(hash-iterate-key
shares_0
i_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(hash-ref
objs_0
obj_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
(hash-iterate-next
shares_0
i_0))))
fold-var_0))))))
(for-loop_0
null
(hash-iterate-first
shares_0)))))))
(let ((lst_0
(sort.1 #f #f share-steps_0 <)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_1 pos_0)
(begin
(if (if (pair? lst_1) #t #f)
(let ((step_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
step_0
pos_0))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
rest_0
(+ pos_0 1)))))
table_0))))))
(for-loop_0
hash2589
lst_0
num-mutables_0)))))))
(let ((stream_0 null))
(let ((stream-size_0 0))
(let ((next-push-position_0
(|#%name|
next-push-position
(lambda () (begin stream-size_0)))))
(let ((quoted?_0
(|#%name|
quoted?
(lambda (pos_0)
(begin
(let ((v_0
(let ((app_0 stream_0))
(list-ref
app_0
(let ((app_1
stream-size_0))
(-
app_1
(add1 pos_0)))))))
(let ((or-part_0
(not (keyword? v_0))))
(if or-part_0
or-part_0
(eq?
kw2626
v_0)))))))))
(let ((ser-reset!_0
(|#%name|
ser-reset!
(lambda (pos_0)
(begin
(begin
(set! stream_0
(let ((app_0 stream_0))
(list-tail
app_0
(-
stream-size_0
pos_0))))
(set! stream-size_0
pos_0)))))))
(let ((reap-stream!_0
(|#%name|
reap-stream!
(lambda ()
(begin
(begin0
(list->vector
(reverse$1 stream_0))
(set! stream_0 null)
(set! stream-size_0
0)))))))
(letrec*
((ser-push!_0
(|#%name|
ser-push!
(case-lambda
((v_0)
(begin
(if (hash-ref shares_0 v_0 #f)
(let ((n_0
(hash-ref
share-step-positions_0
(hash-ref
objs_0
v_0))))
(begin
(ser-push!_0
'tag
kw2603)
(ser-push!_0
'exact
n_0)))
(let ((c1_0
(hash-ref
mutables_0
v_0
#f)))
(if c1_0
(begin
(ser-push!_0
'tag
kw2603)
(ser-push!_0
'exact
c1_0))
(ser-push-encoded!_0
v_0))))))
((kind_0 v_0)
(if (eq? kind_0 'exact)
(begin
(set! stream_0
(cons v_0 stream_0))
(set! stream-size_0
(add1 stream-size_0)))
(if (eq? kind_0 'tag)
(ser-push!_0 'exact v_0)
(if (eq? kind_0 'reference)
(if (hash-ref
shares_0
v_0
#f)
(let ((n_0
(hash-ref
share-step-positions_0
(hash-ref
objs_0
v_0))))
(ser-push!_0
'exact
n_0))
(let ((c2_0
(hash-ref
mutables_0
v_0
#f)))
(if c2_0
(ser-push!_0
'exact
c2_0)
(ser-push!_0 v_0))))
(ser-push!_0 v_0))))))))
(ser-push-encoded!_0
(|#%name|
ser-push-encoded!
(lambda (v_0)
(begin
(if (keyword? v_0)
(begin
(ser-push!_0
'tag
kw2626)
(ser-push!_0 'exact v_0))
(if (1/module-path-index?
v_0)
(begin
(ser-push!_0
'tag
kw3163)
(ser-push!_0
'exact
(add-module-path-index!/pos
mpis5_0
v_0)))
(if (serialize? v_0)
(|#%app|
(serialize-ref v_0)
v_0
ser-push!_0
state_0)
(if (if (list? v_0)
(if (pair? v_0)
(pair? (cdr v_0))
#f)
#f)
(let ((start-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
'tag
kw2802)
(begin
(ser-push!_0
'exact
(length v_0))
(let ((all-quoted?_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (all-quoted?_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((i_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((all-quoted?_1
(let ((all-quoted?_1
(let ((i-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
i_0)
(if all-quoted?_0
(quoted?_0
i-pos_0)
#f)))))
(values
all-quoted?_1))))
(for-loop_0
all-quoted?_1
rest_0))))
all-quoted?_0))))))
(for-loop_0
#t
v_0)))))
(if all-quoted?_0
(begin
(ser-reset!_0
start-pos_0)
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(void))))))
(if (pair? v_0)
(let ((start-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
'tag
kw2821)
(let ((a-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
(car v_0))
(let ((d-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
(cdr
v_0))
(if (if (quoted?_0
a-pos_0)
(quoted?_0
d-pos_0)
#f)
(begin
(ser-reset!_0
start-pos_0)
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(void))))))))
(if (box? v_0)
(let ((start-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
'tag
kw2525)
(let ((v-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
(unbox
v_0))
(if (quoted?_0
v-pos_0)
(begin
(ser-reset!_0
start-pos_0)
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(void))))))
(if (vector? v_0)
(let ((start-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
'tag
kw2967)
(begin
(ser-push!_0
'exact
(vector-length
v_0))
(let ((all-quoted?_0
(call-with-values
(lambda ()
(begin
(check-vector
v_0)
(values
v_0
(unsafe-vector-length
v_0))))
(case-lambda
((vec_0
len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (all-quoted?_0
pos_0)
(begin
(if (unsafe-fx<
pos_0
len_0)
(let ((i_0
(unsafe-vector-ref
vec_0
pos_0)))
(let ((all-quoted?_1
(let ((all-quoted?_1
(let ((i-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
i_0)
(if all-quoted?_0
(quoted?_0
i-pos_0)
#f)))))
(values
all-quoted?_1))))
(for-loop_0
all-quoted?_1
(unsafe-fx+
1
pos_0))))
all-quoted?_0))))))
(for-loop_0
#t
0))))
(args
(raise-binding-result-arity-error
2
args))))))
(if all-quoted?_0
(begin
(ser-reset!_0
start-pos_0)
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(void))))))
(if (hash? v_0)
(let ((start-pos_0
(begin-unsafe
(begin
stream-size_0))))
(let ((as-set?_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0
i_0)
(begin
(if i_0
(let ((val_0
(hash-iterate-value
v_0
i_0)))
(let ((result_1
(eq?
val_0
#t)))
(let ((result_2
(values
result_1)))
(if (if (not
(let ((x_0
(list
val_0)))
(not
result_2)))
#t
#f)
(for-loop_0
result_2
(hash-iterate-next
v_0
i_0))
result_2))))
result_0))))))
(for-loop_0
#t
(hash-iterate-first
v_0))))))
(begin
(ser-push!_0
'tag
(if as-set?_0
(if (hash-eq?
v_0)
kw3357
(if (hash-eqv?
v_0)
kw2333
kw2473))
(if (hash-eq?
v_0)
kw2796
(if (hash-eqv?
v_0)
kw3245
kw2582))))
(begin
(ser-push!_0
'exact
(hash-count
v_0))
(let ((ks_0
(sorted-hash-keys
v_0)))
(let ((all-quoted?_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (all-quoted?_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((k_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((all-quoted?_1
(let ((all-quoted?_1
(let ((k-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
k_0)
(let ((v-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(if as-set?_0
(void)
(ser-push!_0
(hash-ref
v_0
k_0)))
(if all-quoted?_0
(if (quoted?_0
k-pos_0)
(if as-set?_0
as-set?_0
(quoted?_0
v-pos_0))
#f)
#f)))))))
(values
all-quoted?_1))))
(for-loop_0
all-quoted?_1
rest_0))))
all-quoted?_0))))))
(for-loop_0
#t
ks_0)))))
(if all-quoted?_0
(begin
(ser-reset!_0
start-pos_0)
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(void))))))))
(let ((c3_0
(prefab-struct-key
v_0)))
(if c3_0
(let ((vec_0
(struct->vector
v_0)))
(let ((start-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
'tag
kw2931)
(begin
(ser-push!_0
'exact
c3_0)
(begin
(ser-push!_0
'exact
(sub1
(vector-length
vec_0)))
(let ((all-quoted?_0
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
vec_0
1
#f
1))
(case-lambda
((v*_0
start*_0
stop*_0
step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (all-quoted?_0
idx_0)
(begin
(if (unsafe-fx<
idx_0
stop*_0)
(let ((i_0
(unsafe-vector-ref
v*_0
idx_0)))
(let ((all-quoted?_1
(let ((all-quoted?_1
(let ((i-pos_0
(begin-unsafe
(begin
stream-size_0))))
(begin
(ser-push!_0
i_0)
(if all-quoted?_0
(quoted?_0
i-pos_0)
#f)))))
(values
all-quoted?_1))))
(for-loop_0
all-quoted?_1
(unsafe-fx+
idx_0
1))))
all-quoted?_0))))))
(for-loop_0
#t
start*_0))))
(args
(raise-binding-result-arity-error
4
args))))))
(if all-quoted?_0
(begin
(ser-reset!_0
start-pos_0)
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(void))))))))
(if (srcloc?
v_0)
(if (path?
(srcloc-source
v_0))
(begin
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0))
(begin
(ser-push!_0
'tag
kw2496)
(ser-push!_0
(srcloc-source
v_0))
(ser-push!_0
(srcloc-line
v_0))
(ser-push!_0
(srcloc-column
v_0))
(ser-push!_0
(srcloc-position
v_0))
(ser-push!_0
(srcloc-span
v_0))))
(begin
(ser-push-optional-quote!_0)
(ser-push!_0
'exact
v_0)))))))))))))))))
(ser-push-optional-quote!_0
(|#%name|
ser-push-optional-quote!
(lambda () (begin (void))))))
(let ((ser-shell!_0
(|#%name|
ser-shell!
(lambda (v_0)
(begin
(if (serialize-fill!? v_0)
(|#%app|
(serialize-ref v_0)
v_0
ser-push!_0
state_0)
(if (box? v_0)
(ser-push!_0
'tag
kw2525)
(if (vector? v_0)
(begin
(ser-push!_0
'tag
kw2967)
(ser-push!_0
'exact
(vector-length
v_0)))
(if (hash? v_0)
(ser-push!_0
'tag
(if (hash-eq?
v_0)
kw2796
(if (hash-eqv?
v_0)
kw3245
kw2582)))
(error
'ser-shell
"unknown mutable: ~e"
v_0))))))))))
(let ((ser-shell-fill!_0
(|#%name|
ser-shell-fill!
(lambda (v_0)
(begin
(if (serialize-fill!?
v_0)
(|#%app|
(serialize-fill!-ref
v_0)
v_0
ser-push!_0
state_0)
(if (box? v_0)
(begin
(ser-push!_0
'tag
kw2531)
(ser-push!_0
(unbox v_0)))
(if (vector? v_0)
(begin
(ser-push!_0
'tag
kw3046)
(ser-push!_0
'exact
(vector-length
v_0))
(call-with-values
(lambda ()
(begin
(check-vector
v_0)
(values
v_0
(unsafe-vector-length
v_0))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx<
pos_0
len_0)
(let ((v_1
(unsafe-vector-ref
vec_0
pos_0)))
(begin
(ser-push!_0
v_1)
(for-loop_0
(unsafe-fx+
1
pos_0))))
(values)))))))
(for-loop_0
0))))
(args
(raise-binding-result-arity-error
2
args))))
(void))
(if (hash? v_0)
(begin
(ser-push!_0
'tag
kw2194)
(begin
(ser-push!_0
'exact
(hash-count
v_0))
(let ((ks_0
(sorted-hash-keys
v_0)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair?
lst_0)
(let ((k_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(begin
(ser-push!_0
k_0)
(ser-push!_0
(hash-ref
v_0
k_0)))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
ks_0)))
(void)))))
(error
'ser-shell-fill
"unknown mutable: ~e"
v_0))))))))))
(let ((rev-mutables_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
mutables_0
i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
v_0
k_0))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
(hash-iterate-next
mutables_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2589
(hash-iterate-first
mutables_0))))))
(let ((mutable-shell-bindings_0
(begin
(begin
(let ((end_0
(hash-count
mutables_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (<
pos_0
end_0)
(begin
(ser-shell!_0
(hash-ref
rev-mutables_0
pos_0))
(for-loop_0
(+
pos_0
1)))
(values)))))))
(for-loop_0
0))))
(void))
(reap-stream!_0))))
(let ((rev-shares_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0
i_0)
(begin
(if i_0
(let ((obj_0
(hash-iterate-key
shares_0
i_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
(hash-ref
share-step-positions_0
(hash-ref
objs_0
obj_0))
obj_0))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
(hash-iterate-next
shares_0
i_0))))
table_0))))))
(for-loop_0
hash2589
(hash-iterate-first
shares_0))))))
(let ((shared-bindings_0
(begin
(begin
(let ((end_0
(+
num-mutables_0
(hash-count
shares_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (<
pos_0
end_0)
(begin
(ser-push-encoded!_0
(hash-ref
rev-shares_0
pos_0))
(for-loop_0
(+
pos_0
1)))
(values)))))))
(for-loop_0
num-mutables_0))))
(void))
(reap-stream!_0))))
(let ((mutable-fills_0
(begin
(begin
(let ((end_0
(hash-count
mutables_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (<
pos_0
end_0)
(begin
(ser-shell-fill!_0
(hash-ref
rev-mutables_0
pos_0))
(for-loop_0
(+
pos_0
1)))
(values)))))))
(for-loop_0
0))))
(void))
(reap-stream!_0))))
(let ((result_0
(begin
(ser-push!_0
v4_0)
(reap-stream!_0))))
(let ((finish_0
(|#%name|
finish
(lambda (mutable-shell-bindings-expr_0
shared-bindings-expr_0
mutable-fills-expr_0
result-expr_0)
(begin
(let ((app_0
(if syntax-support?2_0
inspector-id
#f)))
(let ((app_1
(if syntax-support?2_0
bulk-binding-registry-id
#f)))
(let ((app_2
(list
'quote
(hash-count
mutables_0))))
(list
'deserialize
mpi-vector-id
app_0
app_1
app_2
mutable-shell-bindings-expr_0
(list
'quote
(hash-count
shares_0))
shared-bindings-expr_0
mutable-fills-expr_0
result-expr_0)))))))))
(let ((app_0
(list
(list
'(data)
(list
'quote
(vector
mutable-shell-bindings_0
shared-bindings_0
mutable-fills_0
result_0))))))
(list
'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)))
(if (null? ks_0)
ks_0
(if (null? (cdr ks_0))
ks_0
(if (andmap_2344 symbol? ks_0)
(sort.1 #f #f ks_0 symbol<?)
(if (andmap_2344 scope? ks_0)
(let ((scope<?21_0 scope<?)) (sort.1 #f #f ks_0 scope<?21_0))
(if (andmap_2344 shifted-multi-scope? ks_0)
(sort.1 #f #f ks_0 shifted-multi-scope<?)
(if (andmap_2344 real? ks_0)
(sort.1 #f #f ks_0 <)
ks_0)))))))))
(define deserialize
(lambda (mpis_0
inspector_0
bulk-binding-registry_0
num-mutables_0
mutable-vec_0
num-shared_0
shared-vec_0
mutable-fill-vec_0
result-vec_0)
(let ((shared_0 (make-vector (+ num-mutables_0 num-shared_0) 'uninit)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0 pos_1)
(begin
(if (< pos_1 num-mutables_0)
(let ((pos_2
(let ((pos_2
(call-with-values
(lambda ()
(decode-shell
mutable-vec_0
pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((d_0 next-pos_0)
(begin
(vector-set! shared_0 pos_1 d_0)
next-pos_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values pos_2))))
(for-loop_0 pos_2 (+ pos_1 1)))
pos_0))))))
(for-loop_0 0 0)))
(begin
(let ((end_0 (+ num-mutables_0 num-shared_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0 pos_1)
(begin
(if (< pos_1 end_0)
(let ((pos_2
(let ((pos_2
(call-with-values
(lambda ()
(decode
shared-vec_0
pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((d_0 next-pos_0)
(begin
(vector-set! shared_0 pos_1 d_0)
next-pos_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values pos_2))))
(for-loop_0 pos_2 (+ pos_1 1)))
pos_0))))))
(for-loop_0 0 num-mutables_0))))
(begin
(let ((start_0 0))
(let ((end_0 num-mutables_0))
(let ((inc_0 1))
(call-with-values
(lambda ()
(begin
(check-vector shared_0)
(values shared_0 (unsafe-vector-length shared_0))))
(case-lambda
((vec_0 len_0)
(let ((inc_1 inc_0) (end_1 end_0) (start_1 start_0))
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0 pos_1 pos_2)
(begin
(if (if (< pos_1 end_1)
(unsafe-fx< pos_2 len_0)
#f)
(let ((v_0 (unsafe-vector-ref vec_0 pos_2)))
(let ((pos_3
(let ((pos_3
(decode-fill!
v_0
mutable-fill-vec_0
pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0)))
(values pos_3))))
(for-loop_0
pos_3
(+ pos_1 inc_1)
(unsafe-fx+ 1 pos_2))))
pos_0))))))
(for-loop_0 0 start_1 0)))))
(args (raise-binding-result-arity-error 2 args)))))))
(call-with-values
(lambda ()
(decode
result-vec_0
0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((result_0 done-pos_0) result_0)
(args (raise-binding-result-arity-error 2 args))))))))))
(define decode-shell
(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)
(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)))
(if (eq? tmp_0 kw2582)
(let ((app_0 (make-hasheq))) (values app_0 (add1 pos_0)))
(if (eq? tmp_0 kw2796)
(let ((app_0 (make-hasheq))) (values app_0 (add1 pos_0)))
(if (eq? tmp_0 kw3245)
(let ((app_0 (make-hasheqv))) (values app_0 (add1 pos_0)))
(decode
vec_0
pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0)))))))))
(define decode
(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)))
(let ((index_0
(if (keyword? tmp_0)
(hash-ref hash2936 tmp_0 (lambda () 0))
0)))
(if (unsafe-fx< index_0 14)
(if (unsafe-fx< index_0 6)
(if (unsafe-fx< index_0 2)
(if (unsafe-fx< index_0 1)
(let ((app_0 (unsafe-vector*-ref vec_0 pos_0)))
(values app_0 (add1 pos_0)))
(let ((app_0
(unsafe-vector*-ref
shared_0
(unsafe-vector*-ref vec_0 (add1 pos_0)))))
(values app_0 (+ pos_0 2))))
(if (unsafe-fx< index_0 3)
(values inspector_0 (add1 pos_0))
(if (unsafe-fx< index_0 4)
(values bulk-binding-registry_0 (add1 pos_0))
(if (unsafe-fx< index_0 5)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((content_0 next-pos_0)
(call-with-values
(lambda ()
(let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0)))
(if (exact-integer? i_0)
(let ((app_0 (unsafe-vector*-ref shared_0 i_0)))
(values app_0 (add1 next-pos_0)))
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))))
(case-lambda
((context_0 next-pos_1)
(call-with-values
(lambda ()
(let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1)))
(if (exact-integer? i_0)
(let ((app_0
(unsafe-vector*-ref shared_0 i_0)))
(values app_0 (add1 next-pos_1)))
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))))
(case-lambda
((srcloc_0 next-pos_2)
(values
(deserialize-syntax
content_0
context_0
srcloc_0
#f
#f
inspector_0)
next-pos_2))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((content_0 next-pos_0)
(call-with-values
(lambda ()
(let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0)))
(if (exact-integer? i_0)
(let ((app_0 (unsafe-vector*-ref shared_0 i_0)))
(values app_0 (add1 next-pos_0)))
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))))
(case-lambda
((context_0 next-pos_1)
(call-with-values
(lambda ()
(let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1)))
(if (exact-integer? i_0)
(let ((app_0
(unsafe-vector*-ref shared_0 i_0)))
(values app_0 (add1 next-pos_1)))
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))))
(case-lambda
((srcloc_0 next-pos_2)
(values
(deserialize-datum->syntax
content_0
context_0
srcloc_0
inspector_0)
next-pos_2))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))))))
(if (unsafe-fx< index_0 9)
(if (unsafe-fx< index_0 7)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((content_0 next-pos_0)
(call-with-values
(lambda ()
(let ((i_0 (unsafe-vector*-ref vec_0 next-pos_0)))
(if (exact-integer? i_0)
(let ((app_0 (unsafe-vector*-ref shared_0 i_0)))
(values app_0 (add1 next-pos_0)))
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))))
(case-lambda
((context_0 next-pos_1)
(call-with-values
(lambda ()
(let ((i_0 (unsafe-vector*-ref vec_0 next-pos_1)))
(if (exact-integer? i_0)
(let ((app_0 (unsafe-vector*-ref shared_0 i_0)))
(values app_0 (add1 next-pos_1)))
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))))
(case-lambda
((srcloc_0 next-pos_2)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_2
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((props_0 next-pos_3)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_3
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((tamper_0 next-pos_4)
(values
(deserialize-syntax
content_0
context_0
srcloc_0
props_0
tamper_0
inspector_0)
next-pos_4))
(args
(raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(if (unsafe-fx< index_0 8)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((source_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((line_0 next-pos_1)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((column_0 next-pos_2)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_2
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((position_0 next-pos_3)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_3
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((span_0 next-pos_4)
(values
(unsafe-make-srcloc
source_0
line_0
column_0
position_0
span_0)
next-pos_4))
(args
(raise-binding-result-arity-error 2 args)))))
(args
(raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(let ((app_0 (unsafe-vector*-ref vec_0 (add1 pos_0))))
(values app_0 (+ pos_0 2)))))
(if (unsafe-fx< index_0 11)
(if (unsafe-fx< index_0 10)
(let ((app_0
(unsafe-vector*-ref
mpis_0
(unsafe-vector*-ref vec_0 (add1 pos_0)))))
(values app_0 (+ pos_0 2)))
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((v_0 next-pos_0) (values (box-immutable v_0) next-pos_0))
(args (raise-binding-result-arity-error 2 args)))))
(if (unsafe-fx< index_0 12)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((a_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((d_0 next-pos_1) (values (cons a_0 d_0) next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(if (unsafe-fx< index_0 13)
(let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0))))
(let ((r_0 (make-vector len_0)))
(let ((next-pos_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_1 pos_2)
(begin
(if (< pos_2 len_0)
(let ((pos_3
(let ((pos_3
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(decode
vec_0
pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((v_0 next-pos_0)
(values
v_0
next-pos_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((v_0 next-pos_0)
(begin
(vector-set!
r_0
pos_2
v_0)
next-pos_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values pos_3))))
(for-loop_0 pos_3 (+ pos_2 1)))
pos_1))))))
(for-loop_0 (+ pos_0 2) 0)))))
(values
(if (eq?
(unsafe-vector*-ref vec_0 pos_0)
kw2802)
(vector->list r_0)
(vector->immutable-vector r_0))
next-pos_0))))
(let ((ht_0
(let ((tmp_1 (unsafe-vector*-ref vec_0 pos_0)))
(if (eq? tmp_1 kw2582)
(hash)
(if (eq? tmp_1 kw2796)
(hasheq)
(if (eq? tmp_1 kw3245)
(hasheqv)
(void)))))))
(let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_1 pos_1 pos_2)
(begin
(if (< pos_2 len_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(decode
vec_0
pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((k_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((v_0 next-pos_1)
(values
(hash-set ht_1 k_0 v_0)
next-pos_1))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ht_2 pos_3) (values ht_2 pos_3))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ht_2 pos_3)
(for-loop_0 ht_2 pos_3 (+ pos_2 1)))
(args
(raise-binding-result-arity-error
2
args))))
(values ht_1 pos_1)))))))
(for-loop_0 ht_0 (+ pos_0 2) 0))))))))))
(if (unsafe-fx< index_0 21)
(if (unsafe-fx< index_0 17)
(if (unsafe-fx< index_0 15)
(let ((s_0
(let ((tmp_1 (unsafe-vector*-ref vec_0 pos_0)))
(if (eq? tmp_1 kw2473)
(set)
(if (eq? tmp_1 kw3357)
(seteq)
(if (eq? tmp_1 kw2333)
(begin-unsafe the-empty-hasheqv)
(void)))))))
(let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_1 pos_1 pos_2)
(begin
(if (< pos_2 len_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(decode
vec_0
pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((k_0 next-pos_0)
(values
(begin-unsafe (hash-set s_1 k_0 #t))
next-pos_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((s_2 pos_3) (values s_2 pos_3))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((s_2 pos_3)
(for-loop_0 s_2 pos_3 (+ pos_2 1)))
(args
(raise-binding-result-arity-error 2 args))))
(values s_1 pos_1)))))))
(for-loop_0 s_0 (+ pos_0 2) 0)))))
(if (unsafe-fx< index_0 16)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((k_0 next-pos_0) (values k_0 next-pos_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((key_0 next-pos_0)
(let ((len_0 (unsafe-vector*-ref vec_0 next-pos_0)))
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (r_0 pos_1 pos_2)
(begin
(if (< pos_2 len_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(decode
vec_0
pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((v_0 next-pos_1)
(values
(cons v_0 r_0)
next-pos_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((r_1 pos_3) (values r_1 pos_3))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((r_1 pos_3)
(for-loop_0 r_1 pos_3 (+ pos_2 1)))
(args
(raise-binding-result-arity-error
2
args))))
(values r_0 pos_1)))))))
(for-loop_0 null (add1 next-pos_0) 0))))
(case-lambda
((r_0 done-pos_0)
(values
(apply make-prefab-struct key_0 (reverse$1 r_0))
done-pos_0))
(args (raise-binding-result-arity-error 2 args))))))
(args (raise-binding-result-arity-error 2 args))))
(values (begin-unsafe top-level-common-scope) (add1 pos_0))))
(if (unsafe-fx< index_0 18)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((kind_0 next-pos_0)
(values
(begin-unsafe
(scope1.1
(new-deserialize-scope-id!)
kind_0
empty-binding-table))
next-pos_0))
(args (raise-binding-result-arity-error 2 args))))
(if (unsafe-fx< index_0 19)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((id_0 next-pos_0)
(values (make-interned-scope id_0) next-pos_0))
(args (raise-binding-result-arity-error 2 args))))
(if (unsafe-fx< index_0 20)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((name_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((scopes_0 next-pos_1)
(values
(deserialize-multi-scope name_0 scopes_0)
next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((phase_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((multi-scope_0 next-pos_1)
(values
(begin-unsafe
(intern-shifted-multi-scope phase_0 multi-scope_0))
next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))))))
(if (unsafe-fx< index_0 24)
(if (unsafe-fx< index_0 22)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((syms_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((bulk-bindings_0 next-pos_1)
(values
(begin-unsafe
(table-with-bulk-bindings1.1
syms_0
syms_0
bulk-bindings_0))
next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(if (unsafe-fx< index_0 23)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((scopes_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((bulk_0 next-pos_1)
(values
(begin-unsafe (bulk-binding-at2.1 scopes_0 bulk_0))
next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((kind_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((phase_0 next-pos_1)
(values
(deserialize-representative-scope kind_0 phase_0)
next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))))
(if (unsafe-fx< index_0 26)
(if (unsafe-fx< index_0 25)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((module_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((sym_0 next-pos_1)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((phase_0 next-pos_2)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_2
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((nominal-module_0 next-pos_3)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_3
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((nominal-phase_0 next-pos_4)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_4
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((nominal-sym_0 next-pos_5)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_5
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((nominal-require-phase_0 next-pos_6)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_6
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((free=id_0 next-pos_7)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_7
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((extra-inspector_0 next-pos_8)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_8
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((extra-nominal-bindings_0
next-pos_9)
(values
(deserialize-full-module-binding
module_0
sym_0
phase_0
nominal-module_0
nominal-phase_0
nominal-sym_0
nominal-require-phase_0
free=id_0
extra-inspector_0
extra-nominal-bindings_0)
next-pos_9))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error 2 args)))))
(args
(raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((module_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((sym_0 next-pos_1)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((phase_0 next-pos_2)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_2
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((nominal-module_0 next-pos_3)
(values
(begin-unsafe
(simple-module-binding46.1
module_0
phase_0
sym_0
nominal-module_0))
next-pos_3))
(args
(raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(if (unsafe-fx< index_0 27)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((key_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((free=id_0 next-pos_1)
(values
(begin-unsafe
(full-local-binding1.1 #f free=id_0 key_0))
next-pos_1))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(if (unsafe-fx< index_0 28)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((prefix_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((excepts_0 next-pos_1)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((mpi_0 next-pos_2)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_2
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((provide-phase-level_0 next-pos_3)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_3
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((phase-shift_0 next-pos_4)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_4
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((bulk-binding-registry_1 next-pos_5)
(values
(begin-unsafe
(bulk-binding12.1
#f
prefix_0
excepts_0
#f
mpi_0
provide-phase-level_0
phase-shift_0
bulk-binding-registry_1))
next-pos_5))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((binding_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((protected?_0 next-pos_1)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((syntax?_0 next-pos_2)
(values
(begin-unsafe
(provided1.1 binding_0 protected?_0 syntax?_0))
next-pos_2))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args)))))
(args
(raise-binding-result-arity-error 2 args))))))))))))))
(define decode-fill!
(lambda (v_0 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 #f)
(add1 pos_0)
(if (eq? tmp_0 kw2531)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((c_0 next-pos_0) (begin (set-box! v_0 c_0) next-pos_0))
(args (raise-binding-result-arity-error 2 args))))
(if (eq? tmp_0 kw3046)
(let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_1 pos_2)
(begin
(if (< pos_2 len_0)
(let ((pos_3
(let ((pos_3
(call-with-values
(lambda ()
(decode
vec_0
pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((c_0 next-pos_0)
(begin
(vector-set! v_0 pos_2 c_0)
next-pos_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values pos_3))))
(for-loop_0 pos_3 (+ pos_2 1)))
pos_1))))))
(for-loop_0 (+ pos_0 2) 0))))
(if (eq? tmp_0 kw2194)
(let ((len_0 (unsafe-vector*-ref vec_0 (add1 pos_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_1 pos_2)
(begin
(if (< pos_2 len_0)
(let ((pos_3
(let ((pos_3
(call-with-values
(lambda ()
(decode
vec_0
pos_1
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((key_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((val_0 done-pos_0)
(begin
(hash-set! v_0 key_0 val_0)
done-pos_0))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args))))))
(values pos_3))))
(for-loop_0 pos_3 (+ pos_2 1)))
pos_1))))))
(for-loop_0 (+ pos_0 2) 0))))
(if (eq? tmp_0 kw2576)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((c_0 next-pos_0)
(begin
(begin-unsafe (set-scope-binding-table! v_0 c_0))
next-pos_0))
(args (raise-binding-result-arity-error 2 args))))
(if (eq? tmp_0 kw2073)
(call-with-values
(lambda ()
(decode
vec_0
(add1 pos_0)
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((a_0 next-pos_0)
(call-with-values
(lambda ()
(decode
vec_0
next-pos_0
mpis_0
inspector_0
bulk-binding-registry_0
shared_0))
(case-lambda
((d_0 done-pos_0)
(begin
(begin-unsafe
(begin
(begin-unsafe (set-scope-binding-table! v_0 a_0))
(set-representative-scope-owner! v_0 d_0)))
done-pos_0))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))
(error
'deserialize
"bad fill encoding: ~v"
(unsafe-vector*-ref vec_0 pos_0)))))))))))
(define find-reachable-scopes
(lambda (v_0)
(let ((seen_0 (make-hasheq)))
(let ((reachable-scopes_0 (seteq)))
(let ((get-reachable-scopes_0
(|#%name|
get-reachable-scopes
(lambda () (begin reachable-scopes_0)))))
(let ((scope-triggers_0 (make-hasheq)))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_1)
(begin
(if (interned-literal? v_1)
(void)
(if (hash-ref seen_0 v_1 #f)
(void)
(begin
(hash-set! seen_0 v_1 #t)
(if (scope-with-bindings? v_1)
(begin
(set! reachable-scopes_0
(let ((s_0 reachable-scopes_0))
(begin-unsafe (hash-set s_0 v_1 #t))))
(|#%app| (reach-scopes-ref v_1) v_1 loop_0)
(let ((lst_0
(hash-ref scope-triggers_0 v_1 null)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((proc_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(begin
(|#%app| proc_0 loop_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)
(hash-remove! scope-triggers_0 v_1)
(|#%app|
(scope-with-bindings-ref v_1)
v_1
get-reachable-scopes_0
loop_0
(lambda (sc-unreachable_0 b_0)
(let ((xform_0
(lambda (l_0) (cons b_0 l_0))))
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
scope-triggers_0
sc-unreachable_0
xform_0
null))))))
(if (reach-scopes? v_1)
(|#%app| (reach-scopes-ref v_1) v_1 loop_0)
(if (pair? v_1)
(begin (loop_0 (car v_1)) (loop_0 (cdr v_1)))
(if (vector? v_1)
(begin
(call-with-values
(lambda ()
(begin
(check-vector v_1)
(values
v_1
(unsafe-vector-length v_1))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((e_0
(unsafe-vector-ref
vec_0
pos_0)))
(begin
(loop_0 e_0)
(for-loop_0
(unsafe-fx+
1
pos_0))))
(values)))))))
(for-loop_0 0))))
(args
(raise-binding-result-arity-error
2
args))))
(void))
(if (box? v_1)
(loop_0 (unbox v_1))
(if (hash? v_1)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
v_1
i_0))
(case-lambda
((k_0 v_2)
(begin
(begin
(loop_0 k_0)
(loop_0 v_2))
(for-loop_0
(hash-iterate-next
v_1
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_0
(hash-iterate-first v_1))))
(void))
(if (prefab-struct-key v_1)
(begin
(call-with-values
(lambda ()
(unsafe-normalise-inputs
unsafe-vector-length
(struct->vector v_1)
1
#f
1))
(case-lambda
((v*_0 start*_0 stop*_0 step*_0)
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (idx_0)
(begin
(if (unsafe-fx<
idx_0
stop*_0)
(let ((e_0
(unsafe-vector-ref
v*_0
idx_0)))
(begin
(loop_0 e_0)
(for-loop_0
(unsafe-fx+
idx_0
1))))
(values)))))))
(for-loop_0 start*_0))))
(args
(raise-binding-result-arity-error
4
args))))
(void))
(if (srcloc? v_1)
(loop_0 (srcloc-source v_1))
(void)))))))))))))))))
(loop_0 v_0))
reachable-scopes_0)))))))
(define deserialize-imports
'(deserialize-module-path-indexes
syntax-module-path-index-shift
syntax-shift-phase-level
module-use
deserialize))
(define syntax-module-path-index-shift/no-keywords
(let ((syntax-module-path-index-shift_0
(|#%name|
syntax-module-path-index-shift
(lambda (s27_0 from-mpi28_0 to-mpi29_0 inspector26_0)
(begin
(syntax-module-path-index-shift.1
#f
s27_0
from-mpi28_0
to-mpi29_0
inspector26_0))))))
(|#%name|
syntax-module-path-index-shift
(case-lambda
((s_0 from-mpi_0 to-mpi_0)
(begin (syntax-module-path-index-shift_0 s_0 from-mpi_0 to-mpi_0 #f)))
((s_0 from-mpi_0 to-mpi_0 inspector26_0)
(syntax-module-path-index-shift_0
s_0
from-mpi_0
to-mpi_0
inspector26_0))))))
(define deserialize-instance
(make-instance
'deserialize
#f
'consistent
'deserialize-module-path-indexes
deserialize-module-path-indexes
'syntax-module-path-index-shift
syntax-module-path-index-shift/no-keywords
'syntax-shift-phase-level
syntax-shift-phase-level$1
'module-use
module-use1.1
'deserialize
deserialize))
(define struct:parsed
(make-record-type-descriptor*
'parsed
#f
(|#%nongenerative-uid| parsed)
#f
#f
1
0))
(define effect_3163
(struct-type-install-properties!
struct:parsed
'parsed
1
0
#f
(list (cons prop:authentic #t))
#f
#f
'(0)
#f
'parsed))
(define parsed1.1
(|#%name|
parsed
(record-constructor
(make-record-constructor-descriptor struct:parsed #f #f))))
(define parsed? (|#%name| parsed? (record-predicate struct:parsed)))
(define parsed-s (|#%name| parsed-s (record-accessor struct:parsed 0)))
(define struct:parsed-id
(make-record-type-descriptor*
'parsed-id
struct:parsed
(|#%nongenerative-uid| parsed-id)
#f
#f
2
0))
(define effect_2786
(struct-type-install-properties!
struct:parsed-id
'parsed-id
2
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'parsed-id))
(define parsed-id2.1
(|#%name|
parsed-id
(record-constructor
(make-record-constructor-descriptor struct:parsed-id #f #f))))
(define parsed-id? (|#%name| parsed-id? (record-predicate struct:parsed-id)))
(define parsed-id-binding
(|#%name| parsed-id-binding (record-accessor struct:parsed-id 0)))
(define parsed-id-inspector
(|#%name| parsed-id-inspector (record-accessor struct:parsed-id 1)))
(define struct:parsed-primitive-id
(make-record-type-descriptor*
'parsed-primitive-id
struct:parsed-id
(|#%nongenerative-uid| parsed-primitive-id)
#f
#f
0
0))
(define effect_2054
(struct-type-install-properties!
struct:parsed-primitive-id
'parsed-primitive-id
0
0
struct:parsed-id
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'parsed-primitive-id))
(define parsed-primitive-id3.1
(|#%name|
parsed-primitive-id
(record-constructor
(make-record-constructor-descriptor struct:parsed-primitive-id #f #f))))
(define parsed-primitive-id?
(|#%name|
parsed-primitive-id?
(record-predicate struct:parsed-primitive-id)))
(define struct:parsed-top-id
(make-record-type-descriptor*
'parsed-top-id
struct:parsed-id
(|#%nongenerative-uid| parsed-top-id)
#f
#f
0
0))
(define effect_3596
(struct-type-install-properties!
struct:parsed-top-id
'parsed-top-id
0
0
struct:parsed-id
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'parsed-top-id))
(define parsed-top-id4.1
(|#%name|
parsed-top-id
(record-constructor
(make-record-constructor-descriptor struct:parsed-top-id #f #f))))
(define parsed-top-id?
(|#%name| parsed-top-id? (record-predicate struct:parsed-top-id)))
(define struct:parsed-lambda
(make-record-type-descriptor*
'parsed-lambda
struct:parsed
(|#%nongenerative-uid| parsed-lambda)
#f
#f
2
0))
(define effect_2929
(struct-type-install-properties!
struct:parsed-lambda
'parsed-lambda
2
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'parsed-lambda))
(define parsed-lambda5.1
(|#%name|
parsed-lambda
(record-constructor
(make-record-constructor-descriptor struct:parsed-lambda #f #f))))
(define parsed-lambda?
(|#%name| parsed-lambda? (record-predicate struct:parsed-lambda)))
(define parsed-lambda-keys
(|#%name| parsed-lambda-keys (record-accessor struct:parsed-lambda 0)))
(define parsed-lambda-body
(|#%name| parsed-lambda-body (record-accessor struct:parsed-lambda 1)))
(define struct:parsed-case-lambda
(make-record-type-descriptor*
'parsed-case-lambda
struct:parsed
(|#%nongenerative-uid| parsed-case-lambda)
#f
#f
1
0))
(define effect_2379
(struct-type-install-properties!
struct:parsed-case-lambda
'parsed-case-lambda
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'parsed-case-lambda))
(define parsed-case-lambda6.1
(|#%name|
parsed-case-lambda
(record-constructor
(make-record-constructor-descriptor struct:parsed-case-lambda #f #f))))
(define parsed-case-lambda?
(|#%name| parsed-case-lambda? (record-predicate struct:parsed-case-lambda)))
(define parsed-case-lambda-clauses
(|#%name|
parsed-case-lambda-clauses
(record-accessor struct:parsed-case-lambda 0)))
(define struct:parsed-app
(make-record-type-descriptor*
'parsed-app
struct:parsed
(|#%nongenerative-uid| parsed-app)
#f
#f
2
0))
(define effect_3155
(struct-type-install-properties!
struct:parsed-app
'parsed-app
2
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'parsed-app))
(define parsed-app7.1
(|#%name|
parsed-app
(record-constructor
(make-record-constructor-descriptor struct:parsed-app #f #f))))
(define parsed-app?
(|#%name| parsed-app? (record-predicate struct:parsed-app)))
(define parsed-app-rator
(|#%name| parsed-app-rator (record-accessor struct:parsed-app 0)))
(define parsed-app-rands
(|#%name| parsed-app-rands (record-accessor struct:parsed-app 1)))
(define struct:parsed-if
(make-record-type-descriptor*
'parsed-if
struct:parsed
(|#%nongenerative-uid| parsed-if)
#f
#f
3
0))
(define effect_2697
(struct-type-install-properties!
struct:parsed-if
'parsed-if
3
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'parsed-if))
(define parsed-if8.1
(|#%name|
parsed-if
(record-constructor
(make-record-constructor-descriptor struct:parsed-if #f #f))))
(define parsed-if? (|#%name| parsed-if? (record-predicate struct:parsed-if)))
(define parsed-if-tst
(|#%name| parsed-if-tst (record-accessor struct:parsed-if 0)))
(define parsed-if-thn
(|#%name| parsed-if-thn (record-accessor struct:parsed-if 1)))
(define parsed-if-els
(|#%name| parsed-if-els (record-accessor struct:parsed-if 2)))
(define struct:parsed-set!
(make-record-type-descriptor*
'parsed-set!
struct:parsed
(|#%nongenerative-uid| parsed-set!)
#f
#f
2
0))
(define effect_2794
(struct-type-install-properties!
struct:parsed-set!
'parsed-set!
2
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'parsed-set!))
(define parsed-set!9.1
(|#%name|
parsed-set!
(record-constructor
(make-record-constructor-descriptor struct:parsed-set! #f #f))))
(define parsed-set!?
(|#%name| parsed-set!? (record-predicate struct:parsed-set!)))
(define parsed-set!-id
(|#%name| parsed-set!-id (record-accessor struct:parsed-set! 0)))
(define parsed-set!-rhs
(|#%name| parsed-set!-rhs (record-accessor struct:parsed-set! 1)))
(define struct:parsed-with-continuation-mark
(make-record-type-descriptor*
'parsed-with-continuation-mark
struct:parsed
(|#%nongenerative-uid| parsed-with-continuation-mark)
#f
#f
3
0))
(define effect_2695
(struct-type-install-properties!
struct:parsed-with-continuation-mark
'parsed-with-continuation-mark
3
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'parsed-with-continuation-mark))
(define parsed-with-continuation-mark10.1
(|#%name|
parsed-with-continuation-mark
(record-constructor
(make-record-constructor-descriptor
struct:parsed-with-continuation-mark
#f
#f))))
(define parsed-with-continuation-mark?
(|#%name|
parsed-with-continuation-mark?
(record-predicate struct:parsed-with-continuation-mark)))
(define parsed-with-continuation-mark-key
(|#%name|
parsed-with-continuation-mark-key
(record-accessor struct:parsed-with-continuation-mark 0)))
(define parsed-with-continuation-mark-val
(|#%name|
parsed-with-continuation-mark-val
(record-accessor struct:parsed-with-continuation-mark 1)))
(define parsed-with-continuation-mark-body
(|#%name|
parsed-with-continuation-mark-body
(record-accessor struct:parsed-with-continuation-mark 2)))
(define |struct:parsed-#%variable-reference|
(make-record-type-descriptor*
'|parsed-#%variable-reference|
struct:parsed
(|#%nongenerative-uid| |parsed-#%variable-reference|)
#f
#f
1
0))
(define effect_2144
(struct-type-install-properties!
|struct:parsed-#%variable-reference|
'|parsed-#%variable-reference|
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'|parsed-#%variable-reference|))
(define |parsed-#%variable-reference11.1|
(|#%name|
|parsed-#%variable-reference|
(record-constructor
(make-record-constructor-descriptor
|struct:parsed-#%variable-reference|
#f
#f))))
(define |parsed-#%variable-reference?|
(|#%name|
|parsed-#%variable-reference?|
(record-predicate |struct:parsed-#%variable-reference|)))
(define |parsed-#%variable-reference-id|
(|#%name|
|parsed-#%variable-reference-id|
(record-accessor |struct:parsed-#%variable-reference| 0)))
(define struct:parsed-begin
(make-record-type-descriptor*
'parsed-begin
struct:parsed
(|#%nongenerative-uid| parsed-begin)
#f
#f
1
0))
(define effect_2775
(struct-type-install-properties!
struct:parsed-begin
'parsed-begin
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'parsed-begin))
(define parsed-begin12.1
(|#%name|
parsed-begin
(record-constructor
(make-record-constructor-descriptor struct:parsed-begin #f #f))))
(define parsed-begin?
(|#%name| parsed-begin? (record-predicate struct:parsed-begin)))
(define parsed-begin-body
(|#%name| parsed-begin-body (record-accessor struct:parsed-begin 0)))
(define struct:parsed-begin0
(make-record-type-descriptor*
'parsed-begin0
struct:parsed
(|#%nongenerative-uid| parsed-begin0)
#f
#f
1
0))
(define effect_2776
(struct-type-install-properties!
struct:parsed-begin0
'parsed-begin0
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'parsed-begin0))
(define parsed-begin013.1
(|#%name|
parsed-begin0
(record-constructor
(make-record-constructor-descriptor struct:parsed-begin0 #f #f))))
(define parsed-begin0?
(|#%name| parsed-begin0? (record-predicate struct:parsed-begin0)))
(define parsed-begin0-body
(|#%name| parsed-begin0-body (record-accessor struct:parsed-begin0 0)))
(define struct:parsed-quote
(make-record-type-descriptor*
'parsed-quote
struct:parsed
(|#%nongenerative-uid| parsed-quote)
#f
#f
1
0))
(define effect_2325
(struct-type-install-properties!
struct:parsed-quote
'parsed-quote
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'parsed-quote))
(define parsed-quote14.1
(|#%name|
parsed-quote
(record-constructor
(make-record-constructor-descriptor struct:parsed-quote #f #f))))
(define parsed-quote?
(|#%name| parsed-quote? (record-predicate struct:parsed-quote)))
(define parsed-quote-datum
(|#%name| parsed-quote-datum (record-accessor struct:parsed-quote 0)))
(define struct:parsed-quote-syntax
(make-record-type-descriptor*
'parsed-quote-syntax
struct:parsed
(|#%nongenerative-uid| parsed-quote-syntax)
#f
#f
1
0))
(define effect_2251
(struct-type-install-properties!
struct:parsed-quote-syntax
'parsed-quote-syntax
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'parsed-quote-syntax))
(define parsed-quote-syntax15.1
(|#%name|
parsed-quote-syntax
(record-constructor
(make-record-constructor-descriptor struct:parsed-quote-syntax #f #f))))
(define parsed-quote-syntax?
(|#%name|
parsed-quote-syntax?
(record-predicate struct:parsed-quote-syntax)))
(define parsed-quote-syntax-datum
(|#%name|
parsed-quote-syntax-datum
(record-accessor struct:parsed-quote-syntax 0)))
(define struct:parsed-let_-values
(make-record-type-descriptor*
'parsed-let_-values
struct:parsed
(|#%nongenerative-uid| parsed-let_-values)
#f
#f
3
0))
(define effect_2852
(struct-type-install-properties!
struct:parsed-let_-values
'parsed-let_-values
3
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'parsed-let_-values))
(define parsed-let_-values16.1
(|#%name|
parsed-let_-values
(record-constructor
(make-record-constructor-descriptor struct:parsed-let_-values #f #f))))
(define parsed-let_-values?
(|#%name| parsed-let_-values? (record-predicate struct:parsed-let_-values)))
(define parsed-let_-values-idss
(|#%name|
parsed-let_-values-idss
(record-accessor struct:parsed-let_-values 0)))
(define parsed-let_-values-clauses
(|#%name|
parsed-let_-values-clauses
(record-accessor struct:parsed-let_-values 1)))
(define parsed-let_-values-body
(|#%name|
parsed-let_-values-body
(record-accessor struct:parsed-let_-values 2)))
(define struct:parsed-let-values
(make-record-type-descriptor*
'parsed-let-values
struct:parsed-let_-values
(|#%nongenerative-uid| parsed-let-values)
#f
#f
0
0))
(define effect_2084
(struct-type-install-properties!
struct:parsed-let-values
'parsed-let-values
0
0
struct:parsed-let_-values
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'parsed-let-values))
(define parsed-let-values17.1
(|#%name|
parsed-let-values
(record-constructor
(make-record-constructor-descriptor struct:parsed-let-values #f #f))))
(define parsed-let-values?
(|#%name| parsed-let-values? (record-predicate struct:parsed-let-values)))
(define struct:parsed-letrec-values
(make-record-type-descriptor*
'parsed-letrec-values
struct:parsed-let_-values
(|#%nongenerative-uid| parsed-letrec-values)
#f
#f
0
0))
(define effect_2229
(struct-type-install-properties!
struct:parsed-letrec-values
'parsed-letrec-values
0
0
struct:parsed-let_-values
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'parsed-letrec-values))
(define parsed-letrec-values18.1
(|#%name|
parsed-letrec-values
(record-constructor
(make-record-constructor-descriptor struct:parsed-letrec-values #f #f))))
(define parsed-letrec-values?
(|#%name|
parsed-letrec-values?
(record-predicate struct:parsed-letrec-values)))
(define struct:parsed-define-values
(make-record-type-descriptor*
'parsed-define-values
struct:parsed
(|#%nongenerative-uid| parsed-define-values)
#f
#f
3
0))
(define effect_2623
(struct-type-install-properties!
struct:parsed-define-values
'parsed-define-values
3
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'parsed-define-values))
(define parsed-define-values19.1
(|#%name|
parsed-define-values
(record-constructor
(make-record-constructor-descriptor struct:parsed-define-values #f #f))))
(define parsed-define-values?
(|#%name|
parsed-define-values?
(record-predicate struct:parsed-define-values)))
(define parsed-define-values-ids
(|#%name|
parsed-define-values-ids
(record-accessor struct:parsed-define-values 0)))
(define parsed-define-values-syms
(|#%name|
parsed-define-values-syms
(record-accessor struct:parsed-define-values 1)))
(define parsed-define-values-rhs
(|#%name|
parsed-define-values-rhs
(record-accessor struct:parsed-define-values 2)))
(define struct:parsed-define-syntaxes
(make-record-type-descriptor*
'parsed-define-syntaxes
struct:parsed
(|#%nongenerative-uid| parsed-define-syntaxes)
#f
#f
3
0))
(define effect_1737
(struct-type-install-properties!
struct:parsed-define-syntaxes
'parsed-define-syntaxes
3
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'parsed-define-syntaxes))
(define parsed-define-syntaxes20.1
(|#%name|
parsed-define-syntaxes
(record-constructor
(make-record-constructor-descriptor struct:parsed-define-syntaxes #f #f))))
(define parsed-define-syntaxes?
(|#%name|
parsed-define-syntaxes?
(record-predicate struct:parsed-define-syntaxes)))
(define parsed-define-syntaxes-ids
(|#%name|
parsed-define-syntaxes-ids
(record-accessor struct:parsed-define-syntaxes 0)))
(define parsed-define-syntaxes-syms
(|#%name|
parsed-define-syntaxes-syms
(record-accessor struct:parsed-define-syntaxes 1)))
(define parsed-define-syntaxes-rhs
(|#%name|
parsed-define-syntaxes-rhs
(record-accessor struct:parsed-define-syntaxes 2)))
(define struct:parsed-begin-for-syntax
(make-record-type-descriptor*
'parsed-begin-for-syntax
struct:parsed
(|#%nongenerative-uid| parsed-begin-for-syntax)
#f
#f
1
0))
(define effect_2654
(struct-type-install-properties!
struct:parsed-begin-for-syntax
'parsed-begin-for-syntax
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'parsed-begin-for-syntax))
(define parsed-begin-for-syntax21.1
(|#%name|
parsed-begin-for-syntax
(record-constructor
(make-record-constructor-descriptor
struct:parsed-begin-for-syntax
#f
#f))))
(define parsed-begin-for-syntax?
(|#%name|
parsed-begin-for-syntax?
(record-predicate struct:parsed-begin-for-syntax)))
(define parsed-begin-for-syntax-body
(|#%name|
parsed-begin-for-syntax-body
(record-accessor struct:parsed-begin-for-syntax 0)))
(define |struct:parsed-#%declare|
(make-record-type-descriptor*
'|parsed-#%declare|
struct:parsed
(|#%nongenerative-uid| |parsed-#%declare|)
#f
#f
0
0))
(define effect_2737
(struct-type-install-properties!
|struct:parsed-#%declare|
'|parsed-#%declare|
0
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'|parsed-#%declare|))
(define |parsed-#%declare22.1|
(|#%name|
|parsed-#%declare|
(record-constructor
(make-record-constructor-descriptor |struct:parsed-#%declare| #f #f))))
(define |parsed-#%declare?|
(|#%name| |parsed-#%declare?| (record-predicate |struct:parsed-#%declare|)))
(define struct:parsed-require
(make-record-type-descriptor*
'parsed-require
struct:parsed
(|#%nongenerative-uid| parsed-require)
#f
#f
0
0))
(define effect_2525
(struct-type-install-properties!
struct:parsed-require
'parsed-require
0
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'parsed-require))
(define parsed-require23.1
(|#%name|
parsed-require
(record-constructor
(make-record-constructor-descriptor struct:parsed-require #f #f))))
(define parsed-require?
(|#%name| parsed-require? (record-predicate struct:parsed-require)))
(define |struct:parsed-#%module-begin|
(make-record-type-descriptor*
'|parsed-#%module-begin|
struct:parsed
(|#%nongenerative-uid| |parsed-#%module-begin|)
#f
#f
1
0))
(define effect_2329
(struct-type-install-properties!
|struct:parsed-#%module-begin|
'|parsed-#%module-begin|
1
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'|parsed-#%module-begin|))
(define |parsed-#%module-begin24.1|
(|#%name|
|parsed-#%module-begin|
(record-constructor
(make-record-constructor-descriptor
|struct:parsed-#%module-begin|
#f
#f))))
(define |parsed-#%module-begin?|
(|#%name|
|parsed-#%module-begin?|
(record-predicate |struct:parsed-#%module-begin|)))
(define |parsed-#%module-begin-body|
(|#%name|
|parsed-#%module-begin-body|
(record-accessor |struct:parsed-#%module-begin| 0)))
(define struct:parsed-module
(make-record-type-descriptor*
'parsed-module
struct:parsed
(|#%nongenerative-uid| parsed-module)
#f
#f
10
0))
(define effect_2380
(struct-type-install-properties!
struct:parsed-module
'parsed-module
10
0
struct:parsed
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9)
#f
'parsed-module))
(define parsed-module25.1
(|#%name|
parsed-module
(record-constructor
(make-record-constructor-descriptor struct:parsed-module #f #f))))
(define parsed-module?
(|#%name| parsed-module? (record-predicate struct:parsed-module)))
(define parsed-module-star?
(|#%name| parsed-module-star? (record-accessor struct:parsed-module 0)))
(define parsed-module-name-id
(|#%name| parsed-module-name-id (record-accessor struct:parsed-module 1)))
(define parsed-module-self
(|#%name| parsed-module-self (record-accessor struct:parsed-module 2)))
(define parsed-module-requires
(|#%name| parsed-module-requires (record-accessor struct:parsed-module 3)))
(define parsed-module-provides
(|#%name| parsed-module-provides (record-accessor struct:parsed-module 4)))
(define parsed-module-root-ctx-simple?
(|#%name|
parsed-module-root-ctx-simple?
(record-accessor struct:parsed-module 5)))
(define parsed-module-encoded-root-ctx
(|#%name|
parsed-module-encoded-root-ctx
(record-accessor struct:parsed-module 6)))
(define parsed-module-body
(|#%name| parsed-module-body (record-accessor struct:parsed-module 7)))
(define parsed-module-compiled-module
(|#%name|
parsed-module-compiled-module
(record-accessor struct:parsed-module 8)))
(define parsed-module-compiled-submodules
(|#%name|
parsed-module-compiled-submodules
(record-accessor struct:parsed-module 9)))
(define module-path->mpi.1
(|#%name|
module-path->mpi
(lambda (declared-submodule-names1_0 mod-path3_0 self4_0)
(begin
(if (if (list? mod-path3_0)
(if (= 2 (length mod-path3_0))
(if (eq? 'quote (car mod-path3_0))
(if (symbol? (cadr mod-path3_0))
(hash-ref declared-submodule-names1_0 (cadr mod-path3_0) #f)
#f)
#f)
#f)
#f)
(1/module-path-index-join
(list 'submod "." (cadr mod-path3_0))
self4_0)
(if (if (list? mod-path3_0)
(if (eq? 'submod (car mod-path3_0))
(let ((mod-path_0 (cadr mod-path3_0)))
(if (list? mod-path_0)
(if (= 2 (length mod-path_0))
(if (eq? 'quote (car mod-path_0))
(if (symbol? (cadr mod-path_0))
(hash-ref
declared-submodule-names1_0
(cadr mod-path_0)
#f)
#f)
#f)
#f)
#f))
#f)
#f)
(1/module-path-index-join
(let ((app_0 (cadr (cadr mod-path3_0))))
(list* 'submod "." app_0 (cddr mod-path3_0)))
self4_0)
(1/module-path-index-join mod-path3_0 self4_0)))))))
(define module-path->mpi/context
(lambda (mod-path_0 ctx_0)
(let ((temp7_0
(namespace-mpi
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0))))))
(let ((temp8_0
(begin-unsafe
(expand-context/inner-declared-submodule-names
(root-expand-context/outer-inner ctx_0)))))
(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)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (syms_0 i_0)
(begin
(if i_0
(let ((sc_0 (unsafe-immutable-hash-iterate-key s-scs_0 i_0)))
(let ((syms_1
(let ((syms_1
(set-union
syms_0
(binding-table-symbols
(scope-binding-table sc_0)
s-scs_0
s_0
null))))
(values syms_1))))
(for-loop_0
syms_1
(unsafe-immutable-hash-iterate-next s-scs_0 i_0))))
syms_0))))))
(for-loop_0
(seteq)
(unsafe-immutable-hash-iterate-first s-scs_0)))))))
(define struct:requires+provides
(make-record-type-descriptor*
'requires+provides
#f
(|#%nongenerative-uid| requires+provides)
#f
#f
9
384))
(define effect_2981
(struct-type-install-properties!
struct:requires+provides
'requires+provides
9
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6)
#f
'requires+provides))
(define requires+provides1.1
(|#%name|
requires+provides
(record-constructor
(make-record-constructor-descriptor struct:requires+provides #f #f))))
(define requires+provides?
(|#%name| requires+provides? (record-predicate struct:requires+provides)))
(define requires+provides-self
(|#%name|
requires+provides-self
(record-accessor struct:requires+provides 0)))
(define requires+provides-require-mpis
(|#%name|
requires+provides-require-mpis
(record-accessor struct:requires+provides 1)))
(define requires+provides-require-mpis-in-order
(|#%name|
requires+provides-require-mpis-in-order
(record-accessor struct:requires+provides 2)))
(define requires+provides-requires
(|#%name|
requires+provides-requires
(record-accessor struct:requires+provides 3)))
(define requires+provides-provides
(|#%name|
requires+provides-provides
(record-accessor struct:requires+provides 4)))
(define requires+provides-phase-to-defined-syms
(|#%name|
requires+provides-phase-to-defined-syms
(record-accessor struct:requires+provides 5)))
(define requires+provides-also-required
(|#%name|
requires+provides-also-required
(record-accessor struct:requires+provides 6)))
(define requires+provides-can-cross-phase-persistent?
(|#%name|
requires+provides-can-cross-phase-persistent?
(record-accessor struct:requires+provides 7)))
(define requires+provides-all-bindings-simple?
(|#%name|
requires+provides-all-bindings-simple?
(record-accessor struct:requires+provides 8)))
(define set-requires+provides-can-cross-phase-persistent?!
(|#%name|
set-requires+provides-can-cross-phase-persistent?!
(record-mutator struct:requires+provides 7)))
(define set-requires+provides-all-bindings-simple?!
(|#%name|
set-requires+provides-all-bindings-simple?!
(record-mutator struct:requires+provides 8)))
(define struct:required
(make-record-type-descriptor*
'required
#f
(|#%nongenerative-uid| required)
#f
#f
4
0))
(define effect_2154
(struct-type-install-properties!
struct:required
'required
4
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3)
#f
'required))
(define required2.1
(|#%name|
required
(record-constructor
(make-record-constructor-descriptor struct:required #f #f))))
(define required? (|#%name| required? (record-predicate struct:required)))
(define required-id (|#%name| required-id (record-accessor struct:required 0)))
(define required-phase
(|#%name| required-phase (record-accessor struct:required 1)))
(define required-can-be-shadowed?
(|#%name| required-can-be-shadowed? (record-accessor struct:required 2)))
(define required-as-transformer?
(|#%name| required-as-transformer? (record-accessor struct:required 3)))
(define struct:nominal
(make-record-type-descriptor*
'nominal
#f
(|#%nongenerative-uid| nominal)
#f
#f
4
0))
(define effect_3046
(struct-type-install-properties!
struct:nominal
'nominal
4
0
#f
(list (cons prop:authentic #t))
#f
#f
'(0 1 2 3)
#f
'nominal))
(define nominal3.1
(|#%name|
nominal
(record-constructor
(make-record-constructor-descriptor struct:nominal #f #f))))
(define nominal? (|#%name| nominal? (record-predicate struct:nominal)))
(define nominal-module
(|#%name| nominal-module (record-accessor struct:nominal 0)))
(define nominal-provide-phase
(|#%name| nominal-provide-phase (record-accessor struct:nominal 1)))
(define nominal-require-phase
(|#%name| nominal-require-phase (record-accessor struct:nominal 2)))
(define nominal-sym (|#%name| nominal-sym (record-accessor struct:nominal 3)))
(define struct:bulk-required
(make-record-type-descriptor*
'bulk-required
#f
(|#%nongenerative-uid| bulk-required)
#f
#f
5
0))
(define effect_2563
(struct-type-install-properties!
struct:bulk-required
'bulk-required
5
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4)
#f
'bulk-required))
(define bulk-required4.1
(|#%name|
bulk-required
(record-constructor
(make-record-constructor-descriptor struct:bulk-required #f #f))))
(define bulk-required?
(|#%name| bulk-required? (record-predicate struct:bulk-required)))
(define bulk-required-provides
(|#%name| bulk-required-provides (record-accessor struct:bulk-required 0)))
(define bulk-required-prefix-len
(|#%name| bulk-required-prefix-len (record-accessor struct:bulk-required 1)))
(define bulk-required-s
(|#%name| bulk-required-s (record-accessor struct:bulk-required 2)))
(define bulk-required-provide-phase-level
(|#%name|
bulk-required-provide-phase-level
(record-accessor struct:bulk-required 3)))
(define bulk-required-can-be-shadowed?
(|#%name|
bulk-required-can-be-shadowed?
(record-accessor struct:bulk-required 4)))
(define make-requires+provides.1
(|#%name|
make-requires+provides
(lambda (copy-requires5_0 self7_0)
(begin
(let ((app_0
(if copy-requires5_0
(requires+provides-require-mpis copy-requires5_0)
(make-module-path-index-intern-table))))
(let ((app_1
(if copy-requires5_0
(hash-copy
(requires+provides-require-mpis-in-order copy-requires5_0))
(make-hasheqv))))
(let ((app_2 (make-hasheq)))
(let ((app_3 (make-hasheqv)))
(let ((app_4 (make-hasheqv)))
(requires+provides1.1
self7_0
app_0
app_1
app_2
app_3
app_4
(make-hasheq)
#t
#t))))))))))
(define requires+provides-reset!
(lambda (r+p_0)
(begin
(hash-clear! (requires+provides-requires r+p_0))
(hash-clear! (requires+provides-provides r+p_0))
(hash-clear! (requires+provides-phase-to-defined-syms r+p_0))
(hash-clear! (requires+provides-also-required r+p_0)))))
(define intern-mpi
(lambda (r+p_0 mpi_0)
(intern-module-path-index! (requires+provides-require-mpis r+p_0) mpi_0)))
(define add-required-module!
(lambda (r+p_0 mod-name_0 phase-shift_0 is-cross-phase-persistent?_0)
(let ((mpi_0
(begin-unsafe
(intern-module-path-index!
(requires+provides-require-mpis r+p_0)
mod-name_0))))
(begin
(if (hash-ref
(hash-ref (requires+provides-requires r+p_0) mpi_0 hash2589)
phase-shift_0
#f)
(void)
(begin
(let ((ht_0 (requires+provides-require-mpis-in-order r+p_0)))
(let ((xform_0 (lambda (l_0) (cons mpi_0 l_0))))
(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)
mpi_0
make-hasheqv)))
(hash-set! app_0 phase-shift_0 (make-hasheq)))))
(if is-cross-phase-persistent?_0
(void)
(set-requires+provides-can-cross-phase-persistent?! r+p_0 #f))
mpi_0))))
(define add-defined-or-required-id!.1
(|#%name|
add-defined-or-required-id!
(lambda (as-transformer?10_0
can-be-shadowed?9_0
r+p13_0
id14_0
phase15_0
binding16_0)
(begin
(begin
(if (equal?
phase15_0
(let ((app_0 (module-binding-nominal-phase binding16_0)))
(phase+
app_0
(module-binding-nominal-require-phase binding16_0))))
(void)
(error "internal error: binding phase does not match nominal info"))
(let ((temp109_0 (module-binding-nominal-module binding16_0)))
(let ((temp110_0
(module-binding-nominal-require-phase binding16_0)))
(let ((temp109_1 temp109_0))
(add-defined-or-required-id-at-nominal!.1
as-transformer?10_0
can-be-shadowed?9_0
temp109_1
temp110_0
r+p13_0
id14_0
phase15_0)))))))))
(define add-defined-or-required-id-at-nominal!.1
(|#%name|
add-defined-or-required-id-at-nominal!
(lambda (as-transformer?21_0
can-be-shadowed?20_0
nominal-module18_0
nominal-require-phase19_0
r+p26_0
id27_0
phase28_0)
(begin
(let ((at-mod_0
(hash-ref!
(requires+provides-requires r+p26_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
(let ((app_0
(required2.1
id27_0
phase28_0
can-be-shadowed?20_0
as-transformer?21_0)))
(cons-ish app_0 (hash-ref sym-to-reqds_0 sym_0 null)))))))))))
(define add-bulk-required-ids!.1
(|#%name|
add-bulk-required-ids!
(lambda (accum-update-nominals36_0
can-be-shadowed?34_0
check-and-remove?35_0
excepts31_0
in33_0
prefix30_0
symbols-accum32_0
who37_0
r+p46_0
s47_0
self48_0
nominal-module49_0
phase-shift50_0
provides51_0
provide-phase-level52_0)
(begin
(let ((phase_0 (phase+ provide-phase-level52_0 phase-shift50_0)))
(let ((shortcut-table_0
(if check-and-remove?35_0
(if (> (hash-count provides51_0) 64)
(syntax-mapped-names s47_0 phase_0)
#f)
#f)))
(let ((mpi_0
(begin-unsafe
(intern-module-path-index!
(requires+provides-require-mpis r+p46_0)
nominal-module49_0))))
(let ((at-mod_0
(hash-ref!
(requires+provides-requires r+p46_0)
mpi_0
make-hasheqv)))
(let ((sym-to-reqds_0
(hash-ref! at-mod_0 phase-shift50_0 make-hasheq)))
(let ((prefix-len_0
(if prefix30_0
(string-length (symbol->string prefix30_0))
0)))
(let ((br_0
(bulk-required4.1
provides51_0
prefix-len_0
s47_0
provide-phase-level52_0
can-be-shadowed?34_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (any-already-defined?_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value provides51_0 i_0))
(case-lambda
((out-sym_0 binding/p_0)
(let ((any-already-defined?_1
(if (not
(symbol-interned? out-sym_0))
any-already-defined?_0
(let ((any-already-defined?_1
(begin
(if symbols-accum32_0
(hash-set!
symbols-accum32_0
out-sym_0
#t)
(void))
(if (hash-ref
excepts31_0
out-sym_0
#f)
#f
(let ((sym_0
(if (not
prefix30_0)
out-sym_0
(string->symbol
(let ((app_0
(symbol->string
prefix30_0)))
(string-append
app_0
(symbol->string
out-sym_0)))))))
(let ((already-defined?_0
(if (if check-and-remove?35_0
(let ((or-part_0
(not
shortcut-table_0)))
(if or-part_0
or-part_0
(hash-ref
shortcut-table_0
sym_0
#f)))
#f)
(let ((temp116_0
(datum->syntax$1
s47_0
sym_0
s47_0)))
(let ((temp119_0
(lambda ()
(provide-binding-to-require-binding.1
mpi_0
phase-shift50_0
provide-phase-level52_0
self48_0
binding/p_0
sym_0))))
(let ((temp116_1
temp116_0))
(check-not-defined.1
accum-update-nominals36_0
#t
#t
in33_0
#t
temp119_0
who37_0
r+p46_0
temp116_1
phase_0))))
#f)))
(begin
(if already-defined?_0
(void)
(hash-set!
sym-to-reqds_0
sym_0
(cons-ish
br_0
(hash-ref
sym-to-reqds_0
sym_0
null))))
(if any-already-defined?_0
any-already-defined?_0
already-defined?_0))))))))
(values
any-already-defined?_1)))))
(for-loop_0
any-already-defined?_1
(hash-iterate-next provides51_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
any-already-defined?_0))))))
(for-loop_0
#f
(hash-iterate-first provides51_0)))))))))))))))
(define bulk-required->required
(lambda (br_0 nominal-module_0 phase_0 sym_0)
(let ((prefix-len_0 (bulk-required-prefix-len br_0)))
(let ((out-sym_0
(if (zero? prefix-len_0)
sym_0
(string->symbol
(substring (symbol->string sym_0) prefix-len_0)))))
(let ((binding/p_0 (hash-ref (bulk-required-provides br_0) out-sym_0)))
(let ((app_0 (datum->syntax$1 (bulk-required-s br_0) sym_0)))
(let ((app_1
(phase+ phase_0 (bulk-required-provide-phase-level br_0))))
(required2.1
app_0
app_1
(bulk-required-can-be-shadowed? br_0)
(provided-as-transformer? binding/p_0)))))))))
(define normalize-required
(lambda (r_0 mod-name_0 phase_0 sym_0)
(if (bulk-required? r_0)
(bulk-required->required r_0 mod-name_0 phase_0 sym_0)
r_0)))
(define add-enclosing-module-defined-and-required!.1
(|#%name|
add-enclosing-module-defined-and-required!
(lambda (enclosing-requires+provides54_0
r+p56_0
enclosing-mod57_0
phase-shift58_0)
(begin
(begin
(set-requires+provides-all-bindings-simple?! r+p56_0 #f)
(let ((ht_0
(requires+provides-requires enclosing-requires+provides54_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((mod-name_0 at-mod_0)
(begin
(begin
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
at-mod_0
i_1))
(case-lambda
((phase_0 at-phase_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (i_2)
(begin
(if i_2
(call-with-values
(lambda ()
(hash-iterate-key+value
at-phase_0
i_2))
(case-lambda
((sym_0 reqds_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_3
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (not
(null?
lst_0))
(let ((reqd/maybe-bulk_0
(if (pair?
lst_0)
(car
lst_0)
lst_0)))
(let ((rest_0
(if (pair?
lst_0)
(cdr
lst_0)
null)))
(let ((reqd/maybe-bulk_1
reqd/maybe-bulk_0))
(begin
(let ((reqd_0
(begin-unsafe
(if (bulk-required?
reqd/maybe-bulk_1)
(bulk-required->required
reqd/maybe-bulk_1
mod-name_0
phase_0
sym_0)
reqd/maybe-bulk_1))))
(let ((temp130_0
(syntax-shift-phase-level$1
(let ((temp136_0
(required-id
reqd_0)))
(let ((temp137_0
(requires+provides-self
enclosing-requires+provides54_0)))
(syntax-module-path-index-shift.1
#f
temp136_0
temp137_0
enclosing-mod57_0
#f)))
phase-shift58_0)))
(let ((temp131_0
(phase+
(required-phase
reqd_0)
phase-shift58_0)))
(let ((temp135_0
(required-as-transformer?
reqd_0)))
(let ((temp131_1
temp131_0)
(temp130_1
temp130_0))
(add-defined-or-required-id-at-nominal!.1
temp135_0
#t
enclosing-mod57_0
phase-shift58_0
r+p56_0
temp130_1
temp131_1))))))
(for-loop_3
rest_0)))))
(values)))))))
(for-loop_3
reqds_0))))
(case-lambda
(()
(for-loop_2
(hash-iterate-next
at-phase_0
i_2)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_2
(hash-iterate-first
at-phase_0)))))
(case-lambda
(()
(for-loop_1
(hash-iterate-next
at-mod_0
i_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_1 (hash-iterate-first at-mod_0))))
(void))
(for-loop_0 (hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0)))))
(void))))))
(define remove-required-id!.1
(|#%name|
remove-required-id!
(lambda (unless-matches60_0 r+p62_0 id63_0 phase64_0)
(begin
(let ((b_0
(resolve+shift.1
#f
#t
null
unsafe-undefined
#f
id63_0
phase64_0)))
(if b_0
(let ((mpi_0
(let ((mpi_0 (module-binding-nominal-module b_0)))
(begin-unsafe
(intern-module-path-index!
(requires+provides-require-mpis r+p62_0)
mpi_0)))))
(let ((at-mod_0
(hash-ref (requires+provides-requires r+p62_0) mpi_0 #f)))
(if at-mod_0
(let ((nominal-phase_0
(module-binding-nominal-require-phase b_0)))
(let ((sym-to-reqds_0
(hash-ref at-mod_0 nominal-phase_0 #f)))
(if sym-to-reqds_0
(let ((sym_0 (syntax-e$1 id63_0)))
(let ((l_0 (hash-ref sym-to-reqds_0 sym_0 null)))
(if (null? l_0)
(void)
(if (same-binding? b_0 unless-matches60_0)
(void)
(hash-set!
sym-to-reqds_0
sym_0
(remove-non-matching-requireds
l_0
id63_0
phase64_0
mpi_0
nominal-phase_0
sym_0))))))
(void))))
(void))))
(void)))))))
(define remove-non-matching-requireds
(lambda (reqds_0 id_0 phase_0 mpi_0 nominal-phase_0 sym_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (not (null? lst_0))
(let ((r_0 (if (pair? lst_0) (car lst_0) lst_0)))
(let ((rest_0 (if (pair? lst_0) (cdr lst_0) null)))
(let ((r_1 r_0))
(let ((fold-var_1
(let ((r_2
(begin-unsafe
(if (bulk-required? r_1)
(bulk-required->required
r_1
mpi_0
nominal-phase_0
sym_0)
r_1))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1)
(begin
(let ((fold-var_2
(if (if (eqv?
phase_0
(required-phase r_2))
(free-identifier=?$1
(required-id r_2)
id_0
phase_0
phase_0)
#f)
fold-var_1
(let ((fold-var_2
(cons
r_2
fold-var_1)))
(values fold-var_2)))))
fold-var_2))))))
(for-loop_1 fold-var_0))))))
(for-loop_0 fold-var_1 rest_0)))))
fold-var_0))))))
(for-loop_0 null reqds_0))))))
(define check-not-defined.1
(|#%name|
check-not-defined
(lambda (accum-update-nominals71_0
allow-defined?67_0
check-not-required?66_0
in68_0
remove-shadowed!?70_0
unless-matches69_0
who72_0
r+p80_0
id81_0
phase82_0)
(begin
(let ((b_0
(resolve+shift.1
#f
#t
null
unsafe-undefined
#f
id81_0
phase82_0)))
(if (not b_0)
#f
(if (not (module-binding? b_0))
(raise-syntax-error$1 #f "identifier out of context" id81_0)
(let ((defined?_0
(if b_0
(eq?
(requires+provides-self r+p80_0)
(module-binding-module b_0))
#f)))
(if (if defined?_0
(not
(let ((app_0
(hash-ref
(requires+provides-phase-to-defined-syms r+p80_0)
phase82_0
hash2610)))
(hash-ref app_0 (module-binding-sym b_0) #f)))
#f)
#f
(let ((define-shadowing-require?_0
(if (not defined?_0)
(not check-not-required?66_0)
#f)))
(let ((mpi_0
(let ((mpi_0 (module-binding-nominal-module b_0)))
(begin-unsafe
(intern-module-path-index!
(requires+provides-require-mpis r+p80_0)
mpi_0)))))
(let ((at-mod_0
(hash-ref
(requires+provides-requires r+p80_0)
mpi_0
#f)))
(let ((ok-binding_0
(if (not define-shadowing-require?_0)
(if (procedure? unless-matches69_0)
(|#%app| unless-matches69_0)
unless-matches69_0)
#f)))
(let ((raise-already-bound_0
(|#%name|
raise-already-bound
(lambda (defined?_1 where_0)
(begin
(let ((app_0
(let ((app_0
(if defined?_1
"defined"
"required")))
(string-append
"identifier already "
app_0
(if (begin-unsafe
(eq? phase82_0 0))
""
(if (begin-unsafe
(not phase82_0))
" for label"
(if (= 1 phase82_0)
" for syntax"
(format
" for phase ~a"
phase82_0))))))))
(raise-syntax-error$1
who72_0
app_0
in68_0
id81_0
null
(if (bulk-required? where_0)
(format
"\n also provided by: ~.s"
(syntax->datum$1
(bulk-required-s where_0)))
""))))))))
(if (if (not at-mod_0)
(not define-shadowing-require?_0)
#f)
#f
(if (if ok-binding_0
(same-binding? b_0 ok-binding_0)
#f)
(begin
(if (same-binding-nominals? b_0 ok-binding_0)
(void)
(let ((update!_0
(|#%name|
update!
(lambda ()
(begin
(let ((temp147_0
(let ((temp150_0
(cons
b_0
(module-binding-extra-nominal-bindings
b_0))))
(module-binding-update.1
unsafe-undefined
temp150_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
ok-binding_0))))
(add-binding!.1
#f
#t
id81_0
temp147_0
phase82_0)))))))
(if accum-update-nominals71_0
(set-box!
accum-update-nominals71_0
(cons
update!_0
(unbox accum-update-nominals71_0)))
(update!_0))))
defined?_0)
(if (if defined?_0 allow-defined?67_0 #f)
(let ((also-required_0
(requires+provides-also-required
r+p80_0)))
(let ((prev-b_0
(hash-ref
also-required_0
(module-binding-sym b_0)
#f)))
(begin
(if (if prev-b_0
(not
(same-binding?
ok-binding_0
prev-b_0))
#f)
(raise-already-bound_0 #f #f)
(void))
(hash-set!
also-required_0
(module-binding-sym b_0)
ok-binding_0)
(set-requires+provides-all-bindings-simple?!
r+p80_0
#f)
#t)))
(let ((nominal-phase_0
(module-binding-nominal-require-phase
b_0)))
(let ((sym-to-reqds_0
(hash-ref
at-mod_0
nominal-phase_0
hash2610)))
(let ((reqds_0
(hash-ref
sym-to-reqds_0
(syntax-e$1 id81_0)
null)))
(let ((only-can-can-shadow-require?_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (only-can-can-shadow-require?_0
lst_0)
(begin
(if (not (null? lst_0))
(let ((r_0
(if (pair?
lst_0)
(car lst_0)
lst_0)))
(let ((rest_0
(if (pair?
lst_0)
(cdr
lst_0)
null)))
(let ((r_1 r_0))
(let ((only-can-can-shadow-require?_1
(let ((only-can-can-shadow-require?_1
(if (if (bulk-required?
r_1)
(bulk-required-can-be-shadowed?
r_1)
(required-can-be-shadowed?
r_1))
(begin
(set-requires+provides-all-bindings-simple?!
r+p80_0
#f)
only-can-can-shadow-require?_0)
(if define-shadowing-require?_0
#f
(raise-already-bound_0
defined?_0
r_1)))))
(values
only-can-can-shadow-require?_1))))
(for-loop_0
only-can-can-shadow-require?_1
rest_0)))))
only-can-can-shadow-require?_0))))))
(for-loop_0 #t reqds_0)))))
(begin
(if define-shadowing-require?_0
(begin
(set-requires+provides-all-bindings-simple?!
r+p80_0
#f)
(if only-can-can-shadow-require?_0
(void)
(hash-set!
(requires+provides-also-required
r+p80_0)
(module-binding-sym b_0)
b_0)))
(if (if remove-shadowed!?70_0
(not (null? reqds_0))
#f)
(let ((app_0
(syntax-e$1 id81_0)))
(hash-set!
sym-to-reqds_0
app_0
(remove-non-matching-requireds
reqds_0
id81_0
phase82_0
mpi_0
nominal-phase_0
(syntax-e$1 id81_0))))
(void)))
#f))))))))))))))))))))))
(define add-defined-syms!.1
(|#%name|
add-defined-syms!
(lambda (as-transformer?84_0 r+p86_0 syms87_0 phase88_0)
(begin
(let ((phase-to-defined-syms_0
(requires+provides-phase-to-defined-syms r+p86_0)))
(let ((defined-syms_0
(hash-ref phase-to-defined-syms_0 phase88_0 hash2610)))
(let ((new-defined-syms_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (defined-syms_1 lst_0)
(begin
(if (pair? lst_0)
(let ((sym_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((defined-syms_2
(let ((defined-syms_2
(hash-set
defined-syms_1
sym_0
(if as-transformer?84_0
'transformer
'variable))))
(values defined-syms_2))))
(for-loop_0 defined-syms_2 rest_0))))
defined-syms_1))))))
(for-loop_0 defined-syms_0 syms87_0)))))
(hash-set!
phase-to-defined-syms_0
phase88_0
new-defined-syms_0))))))))
(define defined-sym-kind
(lambda (r+p_0 sym_0 phase_0)
(let ((phase-to-defined-syms_0
(requires+provides-phase-to-defined-syms r+p_0)))
(let ((defined-syms_0
(hash-ref phase-to-defined-syms_0 phase_0 hash2610)))
(hash-ref defined-syms_0 sym_0 #f)))))
(define extract-module-requires
(lambda (r+p_0 mod-name_0 phase_0)
(let ((mpi_0
(begin-unsafe
(intern-module-path-index!
(requires+provides-require-mpis r+p_0)
mod-name_0))))
(let ((at-mod_0 (hash-ref (requires+provides-requires r+p_0) mpi_0 #f)))
(if at-mod_0
(reverse$1
(let ((ht_0 (hash-ref at-mod_0 phase_0 hash2610)))
(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 ht_0 i_0))
(case-lambda
((sym_0 reqds_0)
(let ((fold-var_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1 lst_0)
(begin
(if (not (null? lst_0))
(let ((reqd_0
(if (pair? lst_0)
(car lst_0)
lst_0)))
(let ((rest_0
(if (pair? lst_0)
(cdr lst_0)
null)))
(let ((reqd_1 reqd_0))
(let ((fold-var_2
(let ((fold-var_2
(cons
(begin-unsafe
(if (bulk-required?
reqd_1)
(bulk-required->required
reqd_1
mpi_0
phase_0
sym_0)
reqd_1))
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_0)))))
fold-var_1))))))
(for-loop_1 fold-var_0 reqds_0)))))
(for-loop_0
fold-var_1
(hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
fold-var_0))))))
(for-loop_0 null (hash-iterate-first ht_0))))))
#f)))))
(define extract-module-definitions
(lambda (r+p_0)
(let ((or-part_0
(extract-module-requires r+p_0 (requires+provides-self r+p_0) 0)))
(if or-part_0 or-part_0 null))))
(define extract-all-module-requires
(lambda (r+p_0 mod-name_0 phase_0)
(let ((self_0 (requires+provides-self r+p_0)))
(let ((requires_0 (requires+provides-requires r+p_0)))
(call-with-escape-continuation
(lambda (esc_0)
(reverse$1
(let ((lst_0
(if mod-name_0
(list
(begin-unsafe
(intern-module-path-index!
(requires+provides-require-mpis r+p_0)
mod-name_0)))
(hash-keys requires_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((mod-name_1 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(if (eq? mod-name_1 self_0)
fold-var_0
(let ((phase-to-requireds_0
(hash-ref
requires_0
mod-name_1
hash2589)))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1)
(begin
(let ((fold-var_2
(let ((lst_2
(if (eq?
phase_0
'all)
(hash-keys
phase-to-requireds_0)
(list
phase_0))))
(begin
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (fold-var_2
lst_3)
(begin
(if (pair?
lst_3)
(let ((phase_1
(unsafe-car
lst_3)))
(let ((rest_1
(unsafe-cdr
lst_3)))
(let ((fold-var_3
(let ((ht_0
(hash-ref
phase-to-requireds_0
phase_1
(lambda ()
(|#%app|
esc_0
#f)))))
(begin
(letrec*
((for-loop_3
(|#%name|
for-loop
(lambda (fold-var_3
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
ht_0
i_0))
(case-lambda
((sym_0
reqds_0)
(let ((fold-var_4
(begin
(letrec*
((for-loop_4
(|#%name|
for-loop
(lambda (fold-var_4
lst_4)
(begin
(if (not
(null?
lst_4))
(let ((reqd_0
(if (pair?
lst_4)
(car
lst_4)
lst_4)))
(let ((rest_2
(if (pair?
lst_4)
(cdr
lst_4)
null)))
(let ((reqd_1
reqd_0))
(let ((fold-var_5
(let ((fold-var_5
(cons
(begin-unsafe
(if (bulk-required?
reqd_1)
(bulk-required->required
reqd_1
mod-name_1
phase_1
sym_0)
reqd_1))
fold-var_4)))
(values
fold-var_5))))
(for-loop_4
fold-var_5
rest_2)))))
fold-var_4))))))
(for-loop_4
fold-var_3
reqds_0)))))
(for-loop_3
fold-var_4
(hash-iterate-next
ht_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
fold-var_3))))))
(for-loop_3
fold-var_2
(hash-iterate-first
ht_0)))))))
(for-loop_2
fold-var_3
rest_1))))
fold-var_2))))))
(for-loop_2
fold-var_1
lst_2))))))
fold-var_2))))))
(for-loop_1 fold-var_0)))))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))))))
(define add-provide!.1
(|#%name|
add-provide!
(lambda (as-protected?90_0
as-transformer?91_0
r+p94_0
sym95_0
phase96_0
binding97_0
immed-binding98_0
id99_0
orig-s100_0)
(begin
(begin
(if (if as-protected?90_0
(not
(eq?
(module-binding-module immed-binding98_0)
(requires+provides-self r+p94_0)))
#f)
(raise-syntax-error$1
#f
"cannot protect required identifier in re-provide"
sym95_0)
(void))
(let ((ht_0 (requires+provides-provides r+p94_0)))
(let ((xform_0
(lambda (at-phase_0)
(let ((b/p_0 (hash-ref at-phase_0 sym95_0 #f)))
(let ((b_0 (provided-as-binding b/p_0)))
(if (not b_0)
(let ((plain-binding_0
(if (binding-free=id binding97_0)
(module-binding-update.1
unsafe-undefined
unsafe-undefined
unsafe-undefined
#f
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
binding97_0)
binding97_0)))
(hash-set
at-phase_0
sym95_0
(if (if as-protected?90_0
as-protected?90_0
as-transformer?91_0)
(provided1.1
plain-binding_0
as-protected?90_0
as-transformer?91_0)
plain-binding_0)))
(if (same-binding? b_0 binding97_0)
at-phase_0
(raise-syntax-error$1
#f
"identifier already provided (as a different binding)"
orig-s100_0
id99_0))))))))
(let ((default_0 hash2610))
(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
(|#%name|
extract-requires
(lambda ()
(begin
(let ((phase-to-mpis-in-order_0
(requires+provides-require-mpis-in-order r+p_0)))
(let ((phases-in-order_0
(let ((temp153_0
(hash-keys phase-to-mpis-in-order_0)))
(sort.1 #f #f temp153_0 phase<?))))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((phase_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(cons
phase_0
(reverse$1
(let ((lst_1
(reverse$1
(hash-ref
phase-to-mpis-in-order_0
phase_0))))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_2)
(begin
(if (pair?
lst_2)
(let ((mpi_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((fold-var_2
(if (eq?
mpi_0
old-self_0)
fold-var_1
(let ((fold-var_2
(cons
(module-path-index-shift
mpi_0
old-self_0
new-self_0)
fold-var_1)))
(values
fold-var_2)))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
lst_1))))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null phases-in-order_0)))))))))))
(let ((extract-provides_0
(|#%name|
extract-provides
(lambda ()
(begin
(shift-provides-module-path-index
(requires+provides-provides r+p_0)
old-self_0
new-self_0))))))
(let ((app_0 (extract-requires_0)))
(values app_0 (extract-provides_0)))))))
(define shift-provides-module-path-index
(lambda (provides_0 from-mpi_0 to-mpi_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value provides_0 i_0))
(case-lambda
((phase_0 at-phase_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1 i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
at-phase_0
i_1))
(case-lambda
((sym_0 binding_0)
(let ((table_2
(let ((table_2
(call-with-values
(lambda ()
(values
sym_0
(if (eq?
from-mpi_0
to-mpi_0)
binding_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (binding_1)
(begin
(if (provided?
binding_1)
(provided1.1
(loop_0
(provided-binding
binding_1))
(provided-protected?
binding_1)
(provided-syntax?
binding_1))
(binding-module-path-index-shift
binding_1
from-mpi_0
to-mpi_0)))))))
(loop_0
binding_0)))))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))))
(for-loop_1
table_2
(hash-iterate-next
at-phase_0
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
table_1))))))
(for-loop_1
hash2610
(hash-iterate-first at-phase_0))))))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (hash-iterate-next provides_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2589 (hash-iterate-first provides_0))))))
(define struct:adjust-only
(make-record-type-descriptor*
'adjust-only
#f
(|#%nongenerative-uid| adjust-only)
#f
#f
1
0))
(define effect_2795
(struct-type-install-properties!
struct:adjust-only
'adjust-only
1
0
#f
null
(current-inspector)
#f
'(0)
#f
'adjust-only))
(define adjust-only1.1
(|#%name|
adjust-only
(record-constructor
(make-record-constructor-descriptor struct:adjust-only #f #f))))
(define adjust-only?_2229
(|#%name| adjust-only? (record-predicate struct:adjust-only)))
(define adjust-only?
(|#%name|
adjust-only?
(lambda (v)
(if (adjust-only?_2229 v)
#t
($value
(if (impersonator? v) (adjust-only?_2229 (impersonator-val v)) #f))))))
(define adjust-only-syms_2775
(|#%name| adjust-only-syms (record-accessor struct:adjust-only 0)))
(define adjust-only-syms
(|#%name|
adjust-only-syms
(lambda (s)
(if (adjust-only?_2229 s)
(adjust-only-syms_2775 s)
($value
(impersonate-ref
adjust-only-syms_2775
struct:adjust-only
0
s
'adjust-only
'syms))))))
(define struct:adjust-prefix
(make-record-type-descriptor*
'adjust-prefix
#f
(|#%nongenerative-uid| adjust-prefix)
#f
#f
1
0))
(define effect_2782
(struct-type-install-properties!
struct:adjust-prefix
'adjust-prefix
1
0
#f
null
(current-inspector)
#f
'(0)
#f
'adjust-prefix))
(define adjust-prefix2.1
(|#%name|
adjust-prefix
(record-constructor
(make-record-constructor-descriptor struct:adjust-prefix #f #f))))
(define adjust-prefix?_2456
(|#%name| adjust-prefix? (record-predicate struct:adjust-prefix)))
(define adjust-prefix?
(|#%name|
adjust-prefix?
(lambda (v)
(if (adjust-prefix?_2456 v)
#t
($value
(if (impersonator? v)
(adjust-prefix?_2456 (impersonator-val v))
#f))))))
(define adjust-prefix-sym_2592
(|#%name| adjust-prefix-sym (record-accessor struct:adjust-prefix 0)))
(define adjust-prefix-sym
(|#%name|
adjust-prefix-sym
(lambda (s)
(if (adjust-prefix?_2456 s)
(adjust-prefix-sym_2592 s)
($value
(impersonate-ref
adjust-prefix-sym_2592
struct:adjust-prefix
0
s
'adjust-prefix
'sym))))))
(define struct:adjust-all-except
(make-record-type-descriptor*
'adjust-all-except
#f
(|#%nongenerative-uid| adjust-all-except)
#f
#f
2
0))
(define effect_3032
(struct-type-install-properties!
struct:adjust-all-except
'adjust-all-except
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'adjust-all-except))
(define adjust-all-except3.1
(|#%name|
adjust-all-except
(record-constructor
(make-record-constructor-descriptor struct:adjust-all-except #f #f))))
(define adjust-all-except?_2297
(|#%name| adjust-all-except? (record-predicate struct:adjust-all-except)))
(define adjust-all-except?
(|#%name|
adjust-all-except?
(lambda (v)
(if (adjust-all-except?_2297 v)
#t
($value
(if (impersonator? v)
(adjust-all-except?_2297 (impersonator-val v))
#f))))))
(define adjust-all-except-prefix-sym_2606
(|#%name|
adjust-all-except-prefix-sym
(record-accessor struct:adjust-all-except 0)))
(define adjust-all-except-prefix-sym
(|#%name|
adjust-all-except-prefix-sym
(lambda (s)
(if (adjust-all-except?_2297 s)
(adjust-all-except-prefix-sym_2606 s)
($value
(impersonate-ref
adjust-all-except-prefix-sym_2606
struct:adjust-all-except
0
s
'adjust-all-except
'prefix-sym))))))
(define adjust-all-except-syms_3082
(|#%name|
adjust-all-except-syms
(record-accessor struct:adjust-all-except 1)))
(define adjust-all-except-syms
(|#%name|
adjust-all-except-syms
(lambda (s)
(if (adjust-all-except?_2297 s)
(adjust-all-except-syms_3082 s)
($value
(impersonate-ref
adjust-all-except-syms_3082
struct:adjust-all-except
1
s
'adjust-all-except
'syms))))))
(define struct:adjust-rename
(make-record-type-descriptor*
'adjust-rename
#f
(|#%nongenerative-uid| adjust-rename)
#f
#f
2
0))
(define effect_2135
(struct-type-install-properties!
struct:adjust-rename
'adjust-rename
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'adjust-rename))
(define adjust-rename4.1
(|#%name|
adjust-rename
(record-constructor
(make-record-constructor-descriptor struct:adjust-rename #f #f))))
(define adjust-rename?_2182
(|#%name| adjust-rename? (record-predicate struct:adjust-rename)))
(define adjust-rename?
(|#%name|
adjust-rename?
(lambda (v)
(if (adjust-rename?_2182 v)
#t
($value
(if (impersonator? v)
(adjust-rename?_2182 (impersonator-val v))
#f))))))
(define adjust-rename-to-id_2236
(|#%name| adjust-rename-to-id (record-accessor struct:adjust-rename 0)))
(define adjust-rename-to-id
(|#%name|
adjust-rename-to-id
(lambda (s)
(if (adjust-rename?_2182 s)
(adjust-rename-to-id_2236 s)
($value
(impersonate-ref
adjust-rename-to-id_2236
struct:adjust-rename
0
s
'adjust-rename
'to-id))))))
(define adjust-rename-from-sym_2159
(|#%name| adjust-rename-from-sym (record-accessor struct:adjust-rename 1)))
(define adjust-rename-from-sym
(|#%name|
adjust-rename-from-sym
(lambda (s)
(if (adjust-rename?_2182 s)
(adjust-rename-from-sym_2159 s)
($value
(impersonate-ref
adjust-rename-from-sym_2159
struct:adjust-rename
1
s
'adjust-rename
'from-sym))))))
(define layers$1 '(raw phaseless path))
(define parse-and-perform-requires!.1
(|#%name|
parse-and-perform-requires!
(lambda (copy-variable-as-constant?11_0
copy-variable-phase-level10_0
declared-submodule-names9_0
initial-require?13_0
run-phase6_0
run?7_0
self5_0
skip-variable-phase-level12_0
visit?8_0
who14_0
reqs25_0
orig-s26_0
m-ns27_0
phase-shift28_0
requires+provides29_0)
(begin
(let ((run-phase_0
(if (eq? run-phase6_0 unsafe-undefined)
(namespace-phase m-ns27_0)
run-phase6_0)))
(let ((initial-require?_0 initial-require?13_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (reqs_0
top-req_0
phase-shift_0
just-meta_0
adjust_0
for-meta-ok?_0
just-meta-ok?_0
layer_0)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((req_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((check-nested_0
(|#%name|
check-nested
(lambda (want-layer107_0 ok?106_0)
(begin
(if (if ok?106_0
(member
want-layer107_0
(member
layer_0
layers$1))
#f)
(void)
(raise-syntax-error$1
#f
"invalid nesting"
orig-s26_0
req_0)))))))
(let ((result_1
(let ((result_1
(let ((check-nested_1
(|#%name|
check-nested
(case-lambda
((want-layer_0)
(begin
(check-nested_0
want-layer_0
#t)))
((want-layer_0
ok?106_0)
(check-nested_0
want-layer_0
ok?106_0))))))
(let ((fm_0
(if (pair?
(syntax-e$1
req_0))
(if (identifier?
(car
(syntax-e$1
req_0)))
(syntax-e$1
(car
(syntax-e$1
req_0)))
#f)
#f)))
(if (eq? fm_0 'for-meta)
(begin
(check-nested_1
'raw
for-meta-ok?_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((for-meta111_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 ((phase-level114_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((spec115_0
(let ((s_3
(cdr
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"
req_0)
flat-s_0))))))
(let ((phase-level114_1
phase-level114_0))
(values
phase-level114_1
spec115_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((phase-level112_0
spec113_0)
(let ((for-meta111_1
for-meta111_0))
(values
for-meta111_1
phase-level112_0
spec113_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((for-meta108_0
phase-level109_0
spec110_0)
(values
#t
for-meta108_0
phase-level109_0
spec110_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
for-meta108_0
phase-level109_0
spec110_0)
(let ((p_0
(syntax-e$1
phase-level109_0)))
(begin
(if (phase?
p_0)
(void)
(raise-syntax-error$1
#f
"bad phase"
orig-s26_0
req_0))
(let ((app_0
(if top-req_0
top-req_0
req_0)))
(loop_0
spec110_0
app_0
(phase+
phase-shift_0
p_0)
just-meta_0
adjust_0
#f
just-meta-ok?_0
'raw)))))
(args
(raise-binding-result-arity-error
4
args)))))
(if (eq?
fm_0
'for-syntax)
(begin
(check-nested_1
'raw
for-meta-ok?_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((for-syntax118_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((spec119_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"
req_0)
flat-s_0))))))
(let ((for-syntax118_1
for-syntax118_0))
(values
for-syntax118_1
spec119_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((for-syntax116_0
spec117_0)
(values
#t
for-syntax116_0
spec117_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
for-syntax116_0
spec117_0)
(let ((app_0
(if top-req_0
top-req_0
req_0)))
(loop_0
spec117_0
app_0
(phase+
phase-shift_0
1)
just-meta_0
adjust_0
#f
just-meta-ok?_0
'raw)))
(args
(raise-binding-result-arity-error
3
args)))))
(if (eq?
fm_0
'for-template)
(begin
(check-nested_1
'raw
for-meta-ok?_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((for-template122_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((spec123_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"
req_0)
flat-s_0))))))
(let ((for-template122_1
for-template122_0))
(values
for-template122_1
spec123_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((for-template120_0
spec121_0)
(values
#t
for-template120_0
spec121_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
for-template120_0
spec121_0)
(let ((app_0
(if top-req_0
top-req_0
req_0)))
(loop_0
spec121_0
app_0
(phase+
phase-shift_0
-1)
just-meta_0
adjust_0
#f
just-meta-ok?_0
'raw)))
(args
(raise-binding-result-arity-error
3
args)))))
(if (eq?
fm_0
'for-label)
(begin
(check-nested_1
'raw
for-meta-ok?_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((for-label126_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((spec127_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"
req_0)
flat-s_0))))))
(let ((for-label126_1
for-label126_0))
(values
for-label126_1
spec127_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((for-label124_0
spec125_0)
(values
#t
for-label124_0
spec125_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
for-label124_0
spec125_0)
(let ((app_0
(if top-req_0
top-req_0
req_0)))
(loop_0
spec125_0
app_0
(phase+
phase-shift_0
#f)
just-meta_0
adjust_0
#f
just-meta-ok?_0
'raw)))
(args
(raise-binding-result-arity-error
3
args)))))
(if (eq?
fm_0
'just-meta)
(begin
(check-nested_1
'raw
just-meta-ok?_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((just-meta131_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 ((phase-level134_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((spec135_0
(let ((s_3
(cdr
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"
req_0)
flat-s_0))))))
(let ((phase-level134_1
phase-level134_0))
(values
phase-level134_1
spec135_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((phase-level132_0
spec133_0)
(let ((just-meta131_1
just-meta131_0))
(values
just-meta131_1
phase-level132_0
spec133_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((just-meta128_0
phase-level129_0
spec130_0)
(values
#t
just-meta128_0
phase-level129_0
spec130_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
just-meta128_0
phase-level129_0
spec130_0)
(let ((p_0
(syntax-e$1
phase-level129_0)))
(begin
(if (phase?
p_0)
(void)
(raise-syntax-error$1
#f
"bad phase"
orig-s26_0
req_0))
(loop_0
spec130_0
(if top-req_0
top-req_0
req_0)
phase-shift_0
p_0
adjust_0
for-meta-ok?_0
#f
'raw))))
(args
(raise-binding-result-arity-error
4
args)))))
(if (eq?
fm_0
'only)
(begin
(check-nested_1
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((only139_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 ((spec142_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((id143_0
(let ((s_3
(cdr
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"
req_0)
(let ((id_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_5
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_1
(let ((id_1
(let ((id144_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"
req_0
s_5))))
(cons
id144_0
id_0))))
(values
id_1))))
(for-loop_1
id_1
rest_1))))
id_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id_0))))))))
(let ((spec142_1
spec142_0))
(values
spec142_1
id143_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((spec140_0
id141_0)
(let ((only139_1
only139_0))
(values
only139_1
spec140_0
id141_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((only136_0
spec137_0
id138_0)
(values
#t
only136_0
spec137_0
id138_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
only136_0
spec137_0
id138_0)
(let ((app_0
(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
args)))))
(if (eq?
fm_0
'prefix)
(begin
(check-nested_1
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((prefix148_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 ((id:prefix151_0
(let ((s_3
(car
s_2)))
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
req_0
s_3)))))
(let ((spec152_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 ((spec153_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"
req_0)))))
(case-lambda
(()
(let ((spec153_1
spec153_0))
(values
spec153_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))))
(let ((id:prefix151_1
id:prefix151_0))
(values
id:prefix151_1
spec152_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((id:prefix149_0
spec150_0)
(let ((prefix148_1
prefix148_0))
(values
prefix148_1
id:prefix149_0
spec150_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((prefix145_0
id:prefix146_0
spec147_0)
(values
#t
prefix145_0
id:prefix146_0
spec147_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
prefix145_0
id:prefix146_0
spec147_0)
(let ((app_0
(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
args)))))
(if (eq?
fm_0
'all-except)
(begin
(check-nested_1
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((all-except157_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 ((spec160_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((id161_0
(let ((s_3
(cdr
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"
req_0)
(let ((id_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_5
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_1
(let ((id_1
(let ((id162_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"
req_0
s_5))))
(cons
id162_0
id_0))))
(values
id_1))))
(for-loop_1
id_1
rest_1))))
id_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id_0))))))))
(let ((spec160_1
spec160_0))
(values
spec160_1
id161_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((spec158_0
id159_0)
(let ((all-except157_1
all-except157_0))
(values
all-except157_1
spec158_0
id159_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((all-except154_0
spec155_0
id156_0)
(values
#t
all-except154_0
spec155_0
id156_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
all-except154_0
spec155_0
id156_0)
(let ((app_0
(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
args)))))
(if (eq?
fm_0
'prefix-all-except)
(begin
(check-nested_1
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((prefix-all-except167_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 ((id:prefix171_0
(let ((s_3
(car
s_2)))
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
req_0
s_3)))))
(call-with-values
(lambda ()
(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 ((spec174_0
(let ((s_5
(car
s_4)))
s_5)))
(let ((id175_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?$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"
req_0)
(let ((id_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_7
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_1
(let ((id_1
(let ((id176_0
(if (let ((or-part_0
(if (syntax?$1
s_7)
(symbol?
(syntax-e$1
s_7))
#f)))
(if or-part_0
or-part_0
(symbol?
s_7)))
s_7
(raise-syntax-error$1
#f
"not an identifier"
req_0
s_7))))
(cons
id176_0
id_0))))
(values
id_1))))
(for-loop_1
id_1
rest_1))))
id_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id_0))))))))
(let ((spec174_1
spec174_0))
(values
spec174_1
id175_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((spec172_0
id173_0)
(let ((id:prefix171_1
id:prefix171_0))
(values
id:prefix171_1
spec172_0
id173_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((id:prefix168_0
spec169_0
id170_0)
(let ((prefix-all-except167_1
prefix-all-except167_0))
(values
prefix-all-except167_1
id:prefix168_0
spec169_0
id170_0)))
(args
(raise-binding-result-arity-error
3
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((prefix-all-except163_0
id:prefix164_0
spec165_0
id166_0)
(values
#t
prefix-all-except163_0
id:prefix164_0
spec165_0
id166_0))
(args
(raise-binding-result-arity-error
4
args)))))
(case-lambda
((ok?_0
prefix-all-except163_0
id:prefix164_0
spec165_0
id166_0)
(let ((app_0
(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
args)))))
(if (eq?
fm_0
'rename)
(begin
(check-nested_1
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
req_0)
(syntax-e$1
req_0)
req_0)))
(if (pair?
s_0)
(let ((rename181_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 ((spec185_0
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(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 ((id:to188_0
(let ((s_5
(car
s_4)))
(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"
req_0
s_5)))))
(let ((id:from189_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?$1
s_5)
(syntax-e$1
s_5)
s_5)))
(if (pair?
s_6)
(let ((id:from190_0
(let ((s_7
(car
s_6)))
(if (let ((or-part_0
(if (syntax?$1
s_7)
(symbol?
(syntax-e$1
s_7))
#f)))
(if or-part_0
or-part_0
(symbol?
s_7)))
s_7
(raise-syntax-error$1
#f
"not an identifier"
req_0
s_7)))))
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?$1
s_7)
(syntax-e$1
s_7)
s_7)))
(if (null?
s_8)
(values)
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
(()
(let ((id:from190_1
id:from190_0))
(values
id:from190_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))))
(let ((id:to188_1
id:to188_0))
(values
id:to188_1
id:from189_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((id:to186_0
id:from187_0)
(let ((spec185_1
spec185_0))
(values
spec185_1
id:to186_0
id:from187_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0)))))
(case-lambda
((spec182_0
id:to183_0
id:from184_0)
(let ((rename181_1
rename181_0))
(values
rename181_1
spec182_0
id:to183_0
id:from184_0)))
(args
(raise-binding-result-arity-error
3
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_0))))
(case-lambda
((rename177_0
spec178_0
id:to179_0
id:from180_0)
(values
#t
rename177_0
spec178_0
id:to179_0
id:from180_0))
(args
(raise-binding-result-arity-error
4
args)))))
(case-lambda
((ok?_0
rename177_0
spec178_0
id:to179_0
id:from180_0)
(let ((app_0
(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
args)))))
(let ((maybe-mp_0
(syntax->datum$1
req_0)))
(begin
(if (let ((or-part_0
(1/module-path?
maybe-mp_0)))
(if or-part_0
or-part_0
(1/resolved-module-path?
maybe-mp_0)))
(void)
(raise-syntax-error$1
#f
"bad require spec"
orig-s26_0
req_0))
(begin
(if (if adjust_0
adjust_0
(not
(eq?
just-meta_0
'all)))
(set-requires+provides-all-bindings-simple?!
requires+provides29_0
#f)
(void))
(let ((mp_0
(if (1/resolved-module-path?
maybe-mp_0)
(resolved-module-path->module-path
maybe-mp_0)
maybe-mp_0)))
(let ((mpi_0
(module-path->mpi.1
declared-submodule-names9_0
mp_0
self5_0)))
(begin
(let ((temp194_0
(if req_0
req_0
top-req_0)))
(let ((initial-require?206_0
initial-require?_0))
(let ((temp194_1
temp194_0))
(perform-require!.1
adjust_0
#t
#f
copy-variable-as-constant?11_0
copy-variable-phase-level10_0
initial-require?206_0
just-meta_0
phase-shift_0
requires+provides29_0
run-phase_0
run?7_0
skip-variable-phase-level12_0
visit?8_0
who14_0
mpi_0
req_0
self5_0
temp194_1
m-ns27_0))))
(set! initial-require?_0
#f)))))))))))))))))))))
(values result_1))))
(if (if (not
(let ((x_0 (list req_0)))
(not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1)))))
result_0))))))
(for-loop_0 #t reqs_0))))))))
(loop_0 reqs25_0 #f phase-shift28_0 'all #f #t #t 'raw))))))))
(define ids->sym-set
(lambda (ids_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0)
(begin
(if (pair? lst_0)
(let ((id_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values (syntax-e$1 id_0) #t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 ids_0)))))
(define perform-initial-require!.1
(|#%name|
perform-initial-require!
(lambda (bind?31_0
who32_0
mod-path35_0
self36_0
in-stx37_0
m-ns38_0
requires+provides39_0)
(begin
(let ((temp211_0 (module-path->mpi.1 hash2610 mod-path35_0 self36_0)))
(perform-require!.1
#f
bind?31_0
#t
#f
#f
#t
'all
0
requires+provides39_0
0
#f
#f
#t
who32_0
temp211_0
#f
self36_0
in-stx37_0
m-ns38_0))))))
(define perform-require!.1
(|#%name|
perform-require!
(lambda (adjust44_0
bind?53_0
can-be-shadowed?48_0
copy-variable-as-constant?51_0
copy-variable-phase-level50_0
initial-require?49_0
just-meta43_0
phase-shift41_0
requires+provides45_0
run-phase42_0
run?47_0
skip-variable-phase-level52_0
visit?46_0
who54_0
mpi69_0
orig-s70_0
self71_0
in-stx72_0
m-ns73_0)
(begin
(begin
(if log-performance?
(start-performance-region 'expand 'require)
(void))
(begin0
(let ((module-name_0 (1/module-path-index-resolve mpi69_0 #t)))
(let ((bind-in-stx_0
(if (adjust-rename? adjust44_0)
(adjust-rename-to-id adjust44_0)
in-stx72_0)))
(let ((done-syms_0 (if adjust44_0 (make-hash) #f)))
(let ((m_0 (namespace->module m-ns73_0 module-name_0)))
(begin
(if m_0
(void)
(begin-unsafe
(raise-arguments-error
'require
"unknown module"
"module name"
(module-name->error-string module-name_0))))
(let ((interned-mpi_0
(if requires+provides45_0
(add-required-module!
requires+provides45_0
mpi69_0
phase-shift41_0
(module-cross-phase-persistent? m_0))
mpi69_0)))
(begin
(if visit?46_0
(namespace-module-visit!.1
run-phase42_0
m-ns73_0
interned-mpi_0
phase-shift41_0)
(void))
(begin
(if run?47_0
(namespace-module-instantiate!.1
#t
run-phase42_0
hash2610
null
#f
m-ns73_0
interned-mpi_0
phase-shift41_0)
(void))
(begin
(if (not (if visit?46_0 visit?46_0 run?47_0))
(namespace-module-make-available!.1
run-phase42_0
m-ns73_0
interned-mpi_0
phase-shift41_0)
(void))
(let ((can-bulk-bind?_0
(if (let ((or-part_0 (not adjust44_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(adjust-prefix?
adjust44_0)))
(if or-part_1
or-part_1
(adjust-all-except?
adjust44_0)))))
(not skip-variable-phase-level52_0)
#f)))
(let ((bulk-prefix_0
(if (adjust-prefix? adjust44_0)
(adjust-prefix-sym adjust44_0)
(if (adjust-all-except? adjust44_0)
(adjust-all-except-prefix-sym
adjust44_0)
#f))))
(let ((bulk-excepts_0
(if (adjust-all-except? adjust44_0)
(adjust-all-except-syms adjust44_0)
hash2610)))
(let ((update-nominals-box_0
(if can-bulk-bind?_0 (box null) #f)))
(begin
(let ((temp232_0
(if requires+provides45_0
(requires+provides-self
requires+provides45_0)
#f)))
(let ((temp233_0
(if (adjust-only? adjust44_0)
(set->list
(adjust-only-syms
adjust44_0))
(if (adjust-rename?
adjust44_0)
(list
(adjust-rename-from-sym
adjust44_0))
#f))))
(let ((temp239_0
(if requires+provides45_0
(if can-bulk-bind?_0
(|#%name|
temp239
(lambda (provides_0
provide-phase-level_0)
(begin
(let ((temp255_0
(module-self
m_0)))
(let ((temp262_0
(if (positive?
(hash-count
bulk-excepts_0))
done-syms_0
#f)))
(let ((temp264_0
(not
initial-require?49_0)))
(let ((temp262_1
temp262_0)
(temp255_1
temp255_0))
(add-bulk-required-ids!.1
update-nominals-box_0
can-be-shadowed?48_0
temp264_0
bulk-excepts_0
orig-s70_0
bulk-prefix_0
temp262_1
who54_0
requires+provides45_0
bind-in-stx_0
temp255_1
mpi69_0
phase-shift41_0
provides_0
provide-phase-level_0))))))))
#f)
#f)))
(let ((temp240_0
(if (let ((or-part_0
(not
can-bulk-bind?_0)))
(if or-part_0
or-part_0
copy-variable-phase-level50_0))
(|#%name|
temp240
(lambda (binding_0
as-transformer?_0)
(begin
(let ((sym_0
(module-binding-nominal-sym
binding_0)))
(let ((provide-phase_0
(module-binding-nominal-phase
binding_0)))
(let ((adjusted-sym_0
(if (not
(symbol-interned?
sym_0))
#f
(if (if skip-variable-phase-level52_0
(if (not
as-transformer?_0)
(equal?
provide-phase_0
skip-variable-phase-level52_0)
#f)
#f)
#f
(if (not
adjust44_0)
sym_0
(if (adjust-only?
adjust44_0)
(if (let ((s_0
(adjust-only-syms
adjust44_0)))
(begin-unsafe
(hash-ref
s_0
sym_0
#f)))
(if (hash-set!
done-syms_0
sym_0
#t)
sym_0
#f)
#f)
(if (adjust-prefix?
adjust44_0)
(string->symbol
(let ((app_0
(symbol->string
(adjust-prefix-sym
adjust44_0))))
(string-append
app_0
(symbol->string
sym_0))))
(if (adjust-all-except?
adjust44_0)
(if (not
(if (let ((s_0
(adjust-all-except-syms
adjust44_0)))
(begin-unsafe
(hash-ref
s_0
sym_0
#f)))
(hash-set!
done-syms_0
sym_0
#t)
#f))
(string->symbol
(let ((app_0
(symbol->string
(adjust-all-except-prefix-sym
adjust44_0))))
(string-append
app_0
(symbol->string
sym_0))))
#f)
(if (adjust-rename?
adjust44_0)
(if (eq?
sym_0
(adjust-rename-from-sym
adjust44_0))
(if (hash-set!
done-syms_0
sym_0
#t)
(adjust-rename-to-id
adjust44_0)
#f)
#f)
(void))))))))))
(let ((skip-bind?_0
(if (if adjusted-sym_0
requires+provides45_0
#f)
(let ((s_0
(datum->syntax$1
bind-in-stx_0
adjusted-sym_0)))
(let ((bind-phase_0
(phase+
phase-shift41_0
provide-phase_0)))
(let ((skip-bind?_0
(if initial-require?49_0
#f
(check-not-defined.1
#f
#t
#t
orig-s70_0
#t
binding_0
who54_0
requires+provides45_0
s_0
bind-phase_0))))
(begin
(if skip-bind?_0
(void)
(add-defined-or-required-id!.1
as-transformer?_0
can-be-shadowed?48_0
requires+provides45_0
s_0
bind-phase_0
binding_0))
skip-bind?_0))))
#f)))
(begin
(if (if copy-variable-phase-level50_0
(if (not
as-transformer?_0)
(equal?
provide-phase_0
copy-variable-phase-level50_0)
#f)
#f)
(copy-namespace-value
m-ns73_0
sym_0
binding_0
copy-variable-phase-level50_0
phase-shift41_0
copy-variable-as-constant?51_0)
(void))
(if (not
skip-bind?_0)
adjusted-sym_0
#f)))))))))
#f)))
(let ((temp239_1 temp239_0)
(temp233_1 temp233_0)
(temp232_1 temp232_0))
(bind-all-provides!.1
bind?53_0
temp239_1
bulk-excepts_0
bulk-prefix_0
can-bulk-bind?_0
temp232_1
temp240_0
orig-s70_0
just-meta43_0
temp233_1
m_0
bind-in-stx_0
phase-shift41_0
m-ns73_0
interned-mpi_0
module-name_0))))))
(begin
(if update-nominals-box_0
(begin
(let ((lst_0
(unbox
update-nominals-box_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((update!_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(|#%app|
update!_0)
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void))
(void))
(let ((need-syms_0
(if (adjust-only? adjust44_0)
(adjust-only-syms adjust44_0)
(if (adjust-all-except?
adjust44_0)
(adjust-all-except-syms
adjust44_0)
(if (adjust-rename?
adjust44_0)
(set
(adjust-rename-from-sym
adjust44_0))
#f)))))
(if (if need-syms_0
(not
(let ((app_0
(begin-unsafe
(hash-count
need-syms_0))))
(=
app_0
(hash-count
done-syms_0))))
#f)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((sym_0
(unsafe-immutable-hash-iterate-key
need-syms_0
i_0)))
(begin
(if (hash-ref
done-syms_0
sym_0
#f)
(void)
(raise-syntax-error$1
who54_0
"not in nested spec"
orig-s70_0
sym_0))
(for-loop_0
(unsafe-immutable-hash-iterate-next
need-syms_0
i_0))))
(values)))))))
(for-loop_0
(unsafe-immutable-hash-iterate-first
need-syms_0))))
(void))
(void))))))))))))))))))
(if log-performance? (end-performance-region) (void))))))))
(define bind-all-provides!.1
(|#%name|
bind-all-provides!
(lambda (bind?79_0
bulk-callback84_0
bulk-excepts82_0
bulk-prefix81_0
can-bulk?80_0
defines-mpi76_0
filter83_0
in75_0
just-meta78_0
only77_0
m95_0
in-stx96_0
phase-shift97_0
ns98_0
mpi99_0
module-name100_0)
(begin
(let ((self_0 (module-self m95_0)))
(begin
(let ((ht_0 (module-provides m95_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((provide-phase-level_0 provides_0)
(call-with-values
(lambda ()
(if (let ((or-part_0 (eq? just-meta78_0 'all)))
(if or-part_0
or-part_0
(eqv?
just-meta78_0
provide-phase-level_0)))
(begin
(let ((phase_0
(phase+
phase-shift97_0
provide-phase-level_0)))
(let ((need-except?_0
(if bulk-callback84_0
(|#%app|
bulk-callback84_0
provides_0
provide-phase-level_0)
#f)))
(if bind?79_0
(begin
(if filter83_0
(begin
(let ((lst_0
(if only77_0
only77_0
(hash-keys
provides_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 ((binding/p_0
(hash-ref
provides_0
sym_0
#f)))
(if binding/p_0
(let ((b_0
(provide-binding-to-require-binding.1
mpi99_0
phase-shift97_0
provide-phase-level_0
self_0
binding/p_0
sym_0)))
(let ((sym_1
(|#%app|
filter83_0
b_0
(provided-as-transformer?
binding/p_0))))
(if (if sym_1
(not
can-bulk?80_0)
#f)
(let ((temp289_0
(datum->syntax$1
in-stx96_0
sym_1)))
(add-binding!.1
#f
#f
temp289_0
b_0
phase_0))
(void))))
(void)))
(for-loop_1
rest_0))))
(values)))))))
(for-loop_1 lst_0))))
(void))
(void))
(if can-bulk?80_0
(let ((bulk-binding-registry_0
(namespace-bulk-binding-registry
ns98_0)))
(let ((temp293_0
(bulk-binding12.1
(let ((or-part_0
(if (not
bulk-prefix81_0)
(if (zero?
(hash-count
bulk-excepts82_0))
provides_0
#f)
#f)))
(if or-part_0
or-part_0
(if (not
(registered-bulk-provide?
bulk-binding-registry_0
module-name100_0))
(bulk-provides-add-prefix-remove-exceptions
provides_0
bulk-prefix81_0
bulk-excepts82_0)
#f)))
bulk-prefix81_0
bulk-excepts82_0
self_0
mpi99_0
provide-phase-level_0
phase-shift97_0
bulk-binding-registry_0)))
(let ((temp296_0
(if need-except?_0
defines-mpi76_0
#f)))
(let ((temp293_1 temp293_0))
(add-bulk-binding!.1
in75_0
temp296_0
in-stx96_0
temp293_1
phase_0)))))
(void)))
(void))))
(values))
(values)))
(case-lambda
(() (for-loop_0 (hash-iterate-next ht_0 i_0)))
(args
(raise-binding-result-arity-error 0 args)))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0)))))
(void)))))))
(define require-spec-shift-for-syntax
(lambda (req_0)
(let ((rebuild-req_0
(|#%name|
rebuild-req
(lambda (req_1 new-req_0)
(begin (datum->syntax$1 req_1 new-req_0 req_1 req_1))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (shifted?_0)
(begin
(lambda (req_1)
(let ((fm_0
(if (pair? (syntax-e$1 req_1))
(if (identifier? (car (syntax-e$1 req_1)))
(syntax-e$1 (car (syntax-e$1 req_1)))
#f)
#f)))
(if (eq? fm_0 'for-meta)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1 req_1)
(syntax-e$1 req_1)
req_1)))
(if (pair? s_0)
(let ((for-meta300_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 ((phase-level303_0
(let ((s_3 (car s_2))) s_3)))
(let ((spec304_0
(let ((s_3 (cdr 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"
req_1)
flat-s_0))))))
(let ((phase-level303_1
phase-level303_0))
(values
phase-level303_1
spec304_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_1)))))
(case-lambda
((phase-level301_0 spec302_0)
(let ((for-meta300_1 for-meta300_0))
(values
for-meta300_1
phase-level301_0
spec302_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1 #f "bad syntax" req_1))))
(case-lambda
((for-meta297_0 phase-level298_0 spec299_0)
(values #t for-meta297_0 phase-level298_0 spec299_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 for-meta297_0 phase-level298_0 spec299_0)
(let ((p_0 (syntax-e$1 phase-level298_0)))
(begin
(if (phase? p_0)
(void)
(raise-syntax-error$1 #f "bad phase" req_1))
(let ((new-req_0
(let ((app_0 (phase+ p_0 1)))
(list*
for-meta297_0
app_0
(map_1346 (loop_0 #t) spec299_0)))))
(begin-unsafe
(begin
(datum->syntax$1
req_1
new-req_0
req_1
req_1)))))))
(args (raise-binding-result-arity-error 4 args))))
(if (eq? fm_0 'for-syntax)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1 req_1)
(syntax-e$1 req_1)
req_1)))
(if (pair? s_0)
(let ((for-syntax307_0
(let ((s_1 (car s_0))) s_1)))
(let ((spec308_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"
req_1)
flat-s_0))))))
(let ((for-syntax307_1 for-syntax307_0))
(values for-syntax307_1 spec308_0))))
(raise-syntax-error$1 #f "bad syntax" req_1))))
(case-lambda
((for-syntax305_0 spec306_0)
(values #t for-syntax305_0 spec306_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 for-syntax305_0 spec306_0)
(let ((new-req_0
(list*
'for-meta
2
(map_1346 (loop_0 #t) spec306_0))))
(begin-unsafe
(begin
(datum->syntax$1 req_1 new-req_0 req_1 req_1)))))
(args (raise-binding-result-arity-error 3 args))))
(if (eq? fm_0 'for-template)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1 req_1)
(syntax-e$1 req_1)
req_1)))
(if (pair? s_0)
(let ((for-template311_0
(let ((s_1 (car s_0))) s_1)))
(let ((spec312_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"
req_1)
flat-s_0))))))
(let ((for-template311_1
for-template311_0))
(values for-template311_1 spec312_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_1))))
(case-lambda
((for-template309_0 spec310_0)
(values #t for-template309_0 spec310_0))
(args
(raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 for-template309_0 spec310_0)
(let ((new-req_0
(list*
'for-meta
0
(map_1346 (loop_0 #t) spec310_0))))
(begin-unsafe
(begin
(datum->syntax$1
req_1
new-req_0
req_1
req_1)))))
(args (raise-binding-result-arity-error 3 args))))
(if (eq? fm_0 'for-label)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1 req_1)
(syntax-e$1 req_1)
req_1)))
(if (pair? s_0)
(let ((for-label315_0
(let ((s_1 (car s_0))) s_1)))
(let ((spec316_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"
req_1)
flat-s_0))))))
(let ((for-label315_1 for-label315_0))
(values for-label315_1 spec316_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_1))))
(case-lambda
((for-label313_0 spec314_0)
(values #t for-label313_0 spec314_0))
(args
(raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 for-label313_0 spec314_0)
(let ((new-req_0
(list*
for-label313_0
(map_1346 (loop_0 #t) spec314_0))))
(begin-unsafe
(begin
(datum->syntax$1
req_1
new-req_0
req_1
req_1)))))
(args (raise-binding-result-arity-error 3 args))))
(if (eq? fm_0 'just-meta)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1 req_1)
(syntax-e$1 req_1)
req_1)))
(if (pair? s_0)
(let ((just-meta320_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 ((phase-level323_0
(let ((s_3 (car s_2)))
s_3)))
(let ((spec324_0
(let ((s_3
(cdr 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"
req_1)
flat-s_0))))))
(let ((phase-level323_1
phase-level323_0))
(values
phase-level323_1
spec324_0))))
(raise-syntax-error$1
#f
"bad syntax"
req_1)))))
(case-lambda
((phase-level321_0 spec322_0)
(let ((just-meta320_1
just-meta320_0))
(values
just-meta320_1
phase-level321_0
spec322_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
req_1))))
(case-lambda
((just-meta317_0 phase-level318_0 spec319_0)
(values
#t
just-meta317_0
phase-level318_0
spec319_0))
(args
(raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0
just-meta317_0
phase-level318_0
spec319_0)
(let ((new-req_0
(list*
just-meta317_0
phase-level318_0
(map_1346 (loop_0 #f) spec319_0))))
(begin-unsafe
(begin
(datum->syntax$1
req_1
new-req_0
req_1
req_1)))))
(args
(raise-binding-result-arity-error 4 args))))
(if shifted?_0
req_1
(datum->syntax$1
#f
(list 'for-syntax req_1)))))))))))))))
(|#%app| (loop_0 #f) req_0)))))
(define copy-namespace-value
(lambda (m-ns_0
adjusted-sym_0
binding_0
phase-level_0
phase-shift_0
as-constant?_0)
(let ((i-ns_0
(let ((temp326_0
(1/module-path-index-resolve
(module-binding-module binding_0))))
(let ((temp327_0
(phase+
(phase- (module-binding-phase binding_0) phase-level_0)
(namespace-phase m-ns_0))))
(let ((temp326_1 temp326_0))
(namespace->module-namespace.1
#f
#t
void
m-ns_0
temp326_1
temp327_0))))))
(let ((val_0
(let ((app_0 (module-binding-phase binding_0)))
(namespace-get-variable
i-ns_0
app_0
(module-binding-sym binding_0)
(lambda ()
(error
'namespace-require/copy
(let ((app_1
(string-append
"namespace mismatch;\n"
" variable not found\n"
" module: ~a\n"
" variable name: ~s\n"
" phase level: ~s")))
(let ((app_2 (module-binding-module binding_0)))
(let ((app_3 (module-binding-sym binding_0)))
(format
app_1
app_2
app_3
(module-binding-phase binding_0)))))))))))
(namespace-set-variable!
m-ns_0
(phase+ phase-shift_0 phase-level_0)
adjusted-sym_0
val_0
as-constant?_0)))))
(define top-level-instance
(make-instance
'top-level
#f
'constant
top-level-bind!-id
(lambda (id_0
mpi_0
orig-phase_0
phase-shift_0
ns_0
sym_0
trans?_0
trans-val_0)
(let ((phase_0 (phase+ orig-phase_0 phase-shift_0)))
(let ((b_0
(let ((temp7_0
(let ((v_0 (namespace-get-root-expand-ctx ns_0)))
(begin-unsafe
(root-expand-context/outer-frame-id v_0)))))
(make-module-binding.1
#f
null
temp7_0
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
mpi_0
phase_0
sym_0))))
(begin
(add-binding!.1 #f #f id_0 b_0 phase_0)
(if trans?_0
(if trans-val_0
(maybe-install-free=id! trans-val_0 id_0 phase_0)
(void))
(namespace-unset-transformer! ns_0 phase_0 sym_0))))))
top-level-require!-id
(lambda (stx_0 ns_0)
(let ((reqs_0 (cdr (syntax->list$1 stx_0))))
(let ((temp13_0 (namespace-self-mpi/no-top-level ns_0)))
(let ((temp14_0 (namespace-phase ns_0)))
(let ((temp15_0 (make-requires+provides.1 #f #f)))
(let ((temp14_1 temp14_0) (temp13_1 temp13_0))
(parse-and-perform-requires!.1
#f
#f
hash2610
#t
unsafe-undefined
#t
temp13_1
#f
#f
'require
reqs_0
#f
ns_0
temp14_1
temp15_0)))))))))
(define struct:compiled-in-memory
(make-record-type-descriptor*
'compiled-in-memory
#f
(|#%nongenerative-uid| compiled-in-memory)
#f
#f
13
0))
(define effect_2489
(struct-type-install-properties!
struct:compiled-in-memory
'compiled-in-memory
13
0
#f
(list
(cons
prop:custom-write
(lambda (cim_0 port_0 mode_0)
(write (compiled-in-memory-linklet-directory cim_0) port_0))))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9 10 11 12)
#f
'compiled-in-memory))
(define compiled-in-memory1.1
(|#%name|
compiled-in-memory
(record-constructor
(make-record-constructor-descriptor struct:compiled-in-memory #f #f))))
(define compiled-in-memory?_2116
(|#%name| compiled-in-memory? (record-predicate struct:compiled-in-memory)))
(define compiled-in-memory?
(|#%name|
compiled-in-memory?
(lambda (v)
(if (compiled-in-memory?_2116 v)
#t
($value
(if (impersonator? v)
(compiled-in-memory?_2116 (impersonator-val v))
#f))))))
(define compiled-in-memory-linklet-directory_1980
(|#%name|
compiled-in-memory-linklet-directory
(record-accessor struct:compiled-in-memory 0)))
(define compiled-in-memory-linklet-directory
(|#%name|
compiled-in-memory-linklet-directory
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-linklet-directory_1980 s)
($value
(impersonate-ref
compiled-in-memory-linklet-directory_1980
struct:compiled-in-memory
0
s
'compiled-in-memory
'linklet-directory))))))
(define compiled-in-memory-original-self_2522
(|#%name|
compiled-in-memory-original-self
(record-accessor struct:compiled-in-memory 1)))
(define compiled-in-memory-original-self
(|#%name|
compiled-in-memory-original-self
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-original-self_2522 s)
($value
(impersonate-ref
compiled-in-memory-original-self_2522
struct:compiled-in-memory
1
s
'compiled-in-memory
'original-self))))))
(define compiled-in-memory-requires_2380
(|#%name|
compiled-in-memory-requires
(record-accessor struct:compiled-in-memory 2)))
(define compiled-in-memory-requires
(|#%name|
compiled-in-memory-requires
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-requires_2380 s)
($value
(impersonate-ref
compiled-in-memory-requires_2380
struct:compiled-in-memory
2
s
'compiled-in-memory
'requires))))))
(define compiled-in-memory-provides_2636
(|#%name|
compiled-in-memory-provides
(record-accessor struct:compiled-in-memory 3)))
(define compiled-in-memory-provides
(|#%name|
compiled-in-memory-provides
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-provides_2636 s)
($value
(impersonate-ref
compiled-in-memory-provides_2636
struct:compiled-in-memory
3
s
'compiled-in-memory
'provides))))))
(define compiled-in-memory-phase-to-link-module-uses_2832
(|#%name|
compiled-in-memory-phase-to-link-module-uses
(record-accessor struct:compiled-in-memory 4)))
(define compiled-in-memory-phase-to-link-module-uses
(|#%name|
compiled-in-memory-phase-to-link-module-uses
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-phase-to-link-module-uses_2832 s)
($value
(impersonate-ref
compiled-in-memory-phase-to-link-module-uses_2832
struct:compiled-in-memory
4
s
'compiled-in-memory
'phase-to-link-module-uses))))))
(define compiled-in-memory-compile-time-inspector_2366
(|#%name|
compiled-in-memory-compile-time-inspector
(record-accessor struct:compiled-in-memory 5)))
(define compiled-in-memory-compile-time-inspector
(|#%name|
compiled-in-memory-compile-time-inspector
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-compile-time-inspector_2366 s)
($value
(impersonate-ref
compiled-in-memory-compile-time-inspector_2366
struct:compiled-in-memory
5
s
'compiled-in-memory
'compile-time-inspector))))))
(define compiled-in-memory-phase-to-link-extra-inspectorsss_2805
(|#%name|
compiled-in-memory-phase-to-link-extra-inspectorsss
(record-accessor struct:compiled-in-memory 6)))
(define compiled-in-memory-phase-to-link-extra-inspectorsss
(|#%name|
compiled-in-memory-phase-to-link-extra-inspectorsss
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-phase-to-link-extra-inspectorsss_2805 s)
($value
(impersonate-ref
compiled-in-memory-phase-to-link-extra-inspectorsss_2805
struct:compiled-in-memory
6
s
'compiled-in-memory
'phase-to-link-extra-inspectorsss))))))
(define compiled-in-memory-mpis_2702
(|#%name|
compiled-in-memory-mpis
(record-accessor struct:compiled-in-memory 7)))
(define compiled-in-memory-mpis
(|#%name|
compiled-in-memory-mpis
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-mpis_2702 s)
($value
(impersonate-ref
compiled-in-memory-mpis_2702
struct:compiled-in-memory
7
s
'compiled-in-memory
'mpis))))))
(define compiled-in-memory-syntax-literals_2316
(|#%name|
compiled-in-memory-syntax-literals
(record-accessor struct:compiled-in-memory 8)))
(define compiled-in-memory-syntax-literals
(|#%name|
compiled-in-memory-syntax-literals
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-syntax-literals_2316 s)
($value
(impersonate-ref
compiled-in-memory-syntax-literals_2316
struct:compiled-in-memory
8
s
'compiled-in-memory
'syntax-literals))))))
(define compiled-in-memory-pre-compiled-in-memorys_1964
(|#%name|
compiled-in-memory-pre-compiled-in-memorys
(record-accessor struct:compiled-in-memory 9)))
(define compiled-in-memory-pre-compiled-in-memorys
(|#%name|
compiled-in-memory-pre-compiled-in-memorys
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-pre-compiled-in-memorys_1964 s)
($value
(impersonate-ref
compiled-in-memory-pre-compiled-in-memorys_1964
struct:compiled-in-memory
9
s
'compiled-in-memory
'pre-compiled-in-memorys))))))
(define compiled-in-memory-post-compiled-in-memorys_2482
(|#%name|
compiled-in-memory-post-compiled-in-memorys
(record-accessor struct:compiled-in-memory 10)))
(define compiled-in-memory-post-compiled-in-memorys
(|#%name|
compiled-in-memory-post-compiled-in-memorys
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-post-compiled-in-memorys_2482 s)
($value
(impersonate-ref
compiled-in-memory-post-compiled-in-memorys_2482
struct:compiled-in-memory
10
s
'compiled-in-memory
'post-compiled-in-memorys))))))
(define compiled-in-memory-namespace-scopes_2598
(|#%name|
compiled-in-memory-namespace-scopes
(record-accessor struct:compiled-in-memory 11)))
(define compiled-in-memory-namespace-scopes
(|#%name|
compiled-in-memory-namespace-scopes
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-namespace-scopes_2598 s)
($value
(impersonate-ref
compiled-in-memory-namespace-scopes_2598
struct:compiled-in-memory
11
s
'compiled-in-memory
'namespace-scopes))))))
(define compiled-in-memory-purely-functional?_2374
(|#%name|
compiled-in-memory-purely-functional?
(record-accessor struct:compiled-in-memory 12)))
(define compiled-in-memory-purely-functional?
(|#%name|
compiled-in-memory-purely-functional?
(lambda (s)
(if (compiled-in-memory?_2116 s)
(compiled-in-memory-purely-functional?_2374 s)
($value
(impersonate-ref
compiled-in-memory-purely-functional?_2374
struct:compiled-in-memory
12
s
'compiled-in-memory
'purely-functional?))))))
(define version-bytes$1 (string->bytes/utf-8 (version)))
(define vm-bytes$1 (linklet-virtual-machine-bytes))
(define datum->syntax$3 datum->syntax)
(define syntax-property$2 syntax-property)
(define syntax-span$2 syntax-span)
(define syntax-position$2 syntax-position)
(define syntax-column$2 syntax-column)
(define syntax-line$2 syntax-line)
(define syntax-source$2 syntax-source)
(define syntax-e$2 syntax-e)
(define 1/syntax? syntax?)
(define correlated? (lambda (e_0) (syntax? e_0)))
(define datum->correlated
(let ((datum->correlated_0
(|#%name|
datum->correlated
(lambda (d2_0 srcloc1_0)
(begin (datum->syntax #f d2_0 srcloc1_0))))))
(case-lambda
((d_0) (datum->correlated_0 d_0 #f))
((d_0 srcloc1_0) (datum->correlated_0 d_0 srcloc1_0)))))
(define correlated-e (lambda (e_0) (if (syntax? e_0) (syntax-e e_0) e_0)))
(define correlated-cadr
(lambda (e_0) (car (correlated-e (cdr (correlated-e e_0))))))
(define correlated-length
(lambda (e_0)
(let ((l_0 (correlated-e e_0))) (if (list? l_0) (length l_0) #f))))
(define correlated->list
(lambda (e_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (e_1)
(begin
(if (list? e_1)
e_1
(if (pair? e_1)
(let ((app_0 (car e_1))) (cons app_0 (loop_0 (cdr e_1))))
(if (null? e_1)
null
(if (syntax? e_1)
(loop_0 (syntax-e e_1))
(error 'correlated->list "not a list"))))))))))
(loop_0 e_0))))
(define correlated-property
(case-lambda
((e_0 k_0) (syntax-property e_0 k_0))
((e_0 k_0 v_0) (syntax-property e_0 k_0 v_0))))
(define to-syntax-list.1$1
(|#%name|
to-syntax-list
(lambda (s_0)
(begin
(if (list? s_0)
s_0
(if (pair? s_0)
(let ((r_0 (to-syntax-list.1$1 (cdr s_0))))
(if r_0 (cons (car s_0) r_0) #f))
(if (syntax? s_0) (to-syntax-list.1$1 (syntax-e s_0)) #f)))))))
(define correlated-source (lambda (s_0) (syntax-source s_0)))
(define correlated-line (lambda (s_0) (syntax-line s_0)))
(define correlated-column (lambda (s_0) (syntax-column s_0)))
(define correlated-position (lambda (s_0) (syntax-position s_0)))
(define correlated-span (lambda (s_0) (syntax-span s_0)))
(define struct:correlated-linklet
(make-record-type-descriptor*
'correlated-linklet
#f
(|#%nongenerative-uid| correlated-linklet)
#f
#f
3
4))
(define effect_2480
(struct-type-install-properties!
struct:correlated-linklet
'correlated-linklet
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'correlated-linklet))
(define correlated-linklet1.1
(|#%name|
correlated-linklet
(record-constructor
(make-record-constructor-descriptor struct:correlated-linklet #f #f))))
(define correlated-linklet?
(|#%name| correlated-linklet? (record-predicate struct:correlated-linklet)))
(define correlated-linklet-expr
(|#%name|
correlated-linklet-expr
(record-accessor struct:correlated-linklet 0)))
(define correlated-linklet-name
(|#%name|
correlated-linklet-name
(record-accessor struct:correlated-linklet 1)))
(define correlated-linklet-compiled
(|#%name|
correlated-linklet-compiled
(record-accessor struct:correlated-linklet 2)))
(define set-correlated-linklet-compiled!
(|#%name|
set-correlated-linklet-compiled!
(record-mutator struct:correlated-linklet 2)))
(define make-correlated-linklet
(lambda (expr_0 name_0) (correlated-linklet1.1 expr_0 name_0 #f)))
(define force-compile-linklet
(lambda (l_0)
(if (correlated-linklet? l_0)
(let ((or-part_0 (correlated-linklet-compiled l_0)))
(if or-part_0
or-part_0
(let ((c_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
(compile-linklet
(correlated-linklet-expr l_0)
(correlated-linklet-name l_0)
#f
#f
'()))
(error
'eval-correlated-linklet
"cannot evaluate unknown linklet: ~s"
l_0))))
(define correlated-linklet-vm-bytes #vu8(108 105 110 107 108 101 116))
(define struct:faslable-correlated
(make-record-type-descriptor*
'faslable-correlated
#f
(structure-type-lookup-prefab-uid
'faslable-correlated
#f
7
0
#f
'(0 1 2 3 4 5 6))
#f
#f
7
127))
(define effect_2267
(struct-type-install-properties!
struct:faslable-correlated
'faslable-correlated
7
0
#f
null
'prefab
#f
'(0 1 2 3 4 5 6)
#f
'faslable-correlated))
(define faslable-correlated2.1
(|#%name|
faslable-correlated
(record-constructor
(make-record-constructor-descriptor struct:faslable-correlated #f #f))))
(define faslable-correlated?_2779
(|#%name|
faslable-correlated?
(record-predicate struct:faslable-correlated)))
(define faslable-correlated?
(|#%name|
faslable-correlated?
(lambda (v)
(if (faslable-correlated?_2779 v)
#t
($value
(if (impersonator? v)
(faslable-correlated?_2779 (impersonator-val v))
#f))))))
(define faslable-correlated-e_2371
(|#%name|
faslable-correlated-e
(record-accessor struct:faslable-correlated 0)))
(define faslable-correlated-e
(|#%name|
faslable-correlated-e
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-e_2371 s)
($value
(impersonate-ref
faslable-correlated-e_2371
struct:faslable-correlated
0
s
'faslable-correlated
'e))))))
(define faslable-correlated-source_1985
(|#%name|
faslable-correlated-source
(record-accessor struct:faslable-correlated 1)))
(define faslable-correlated-source
(|#%name|
faslable-correlated-source
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-source_1985 s)
($value
(impersonate-ref
faslable-correlated-source_1985
struct:faslable-correlated
1
s
'faslable-correlated
'source))))))
(define faslable-correlated-position_2283
(|#%name|
faslable-correlated-position
(record-accessor struct:faslable-correlated 2)))
(define faslable-correlated-position
(|#%name|
faslable-correlated-position
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-position_2283 s)
($value
(impersonate-ref
faslable-correlated-position_2283
struct:faslable-correlated
2
s
'faslable-correlated
'position))))))
(define faslable-correlated-line_2531
(|#%name|
faslable-correlated-line
(record-accessor struct:faslable-correlated 3)))
(define faslable-correlated-line
(|#%name|
faslable-correlated-line
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-line_2531 s)
($value
(impersonate-ref
faslable-correlated-line_2531
struct:faslable-correlated
3
s
'faslable-correlated
'line))))))
(define faslable-correlated-column_2707
(|#%name|
faslable-correlated-column
(record-accessor struct:faslable-correlated 4)))
(define faslable-correlated-column
(|#%name|
faslable-correlated-column
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-column_2707 s)
($value
(impersonate-ref
faslable-correlated-column_2707
struct:faslable-correlated
4
s
'faslable-correlated
'column))))))
(define faslable-correlated-span_2176
(|#%name|
faslable-correlated-span
(record-accessor struct:faslable-correlated 5)))
(define faslable-correlated-span
(|#%name|
faslable-correlated-span
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-span_2176 s)
($value
(impersonate-ref
faslable-correlated-span_2176
struct:faslable-correlated
5
s
'faslable-correlated
'span))))))
(define faslable-correlated-props_2838
(|#%name|
faslable-correlated-props
(record-accessor struct:faslable-correlated 6)))
(define faslable-correlated-props
(|#%name|
faslable-correlated-props
(lambda (s)
(if (faslable-correlated?_2779 s)
(faslable-correlated-props_2838 s)
($value
(impersonate-ref
faslable-correlated-props_2838
struct:faslable-correlated
6
s
'faslable-correlated
'props))))))
(define struct:faslable-correlated-linklet
(make-record-type-descriptor*
'faslable-correlated-linklet
#f
(structure-type-lookup-prefab-uid
'faslable-correlated-linklet
#f
2
0
#f
'(0 1))
#f
#f
2
3))
(define effect_2546
(struct-type-install-properties!
struct:faslable-correlated-linklet
'faslable-correlated-linklet
2
0
#f
null
'prefab
#f
'(0 1)
#f
'faslable-correlated-linklet))
(define faslable-correlated-linklet3.1
(|#%name|
faslable-correlated-linklet
(record-constructor
(make-record-constructor-descriptor
struct:faslable-correlated-linklet
#f
#f))))
(define faslable-correlated-linklet?_2542
(|#%name|
faslable-correlated-linklet?
(record-predicate struct:faslable-correlated-linklet)))
(define faslable-correlated-linklet?
(|#%name|
faslable-correlated-linklet?
(lambda (v)
(if (faslable-correlated-linklet?_2542 v)
#t
($value
(if (impersonator? v)
(faslable-correlated-linklet?_2542 (impersonator-val v))
#f))))))
(define faslable-correlated-linklet-expr_2739
(|#%name|
faslable-correlated-linklet-expr
(record-accessor struct:faslable-correlated-linklet 0)))
(define faslable-correlated-linklet-expr
(|#%name|
faslable-correlated-linklet-expr
(lambda (s)
(if (faslable-correlated-linklet?_2542 s)
(faslable-correlated-linklet-expr_2739 s)
($value
(impersonate-ref
faslable-correlated-linklet-expr_2739
struct:faslable-correlated-linklet
0
s
'faslable-correlated-linklet
'expr))))))
(define faslable-correlated-linklet-name_2691
(|#%name|
faslable-correlated-linklet-name
(record-accessor struct:faslable-correlated-linklet 1)))
(define faslable-correlated-linklet-name
(|#%name|
faslable-correlated-linklet-name
(lambda (s)
(if (faslable-correlated-linklet?_2542 s)
(faslable-correlated-linklet-name_2691 s)
($value
(impersonate-ref
faslable-correlated-linklet-name_2691
struct:faslable-correlated-linklet
1
s
'faslable-correlated-linklet
'name))))))
(define write-correlated-linklet-bundle-hash
(lambda (ht_0 o_0)
(let ((temp7_0 (->faslable ht_0)))
(s-exp->fasl.1 #f #f #f #f temp7_0 o_0))))
(define ->faslable
(lambda (v_0)
(if (pair? v_0)
(let ((a_0 (->faslable (car v_0))))
(let ((d_0 (->faslable (cdr v_0))))
(if (if (eq? a_0 (car v_0)) (eq? d_0 (cdr v_0)) #f)
v_0
(cons a_0 d_0))))
(if (begin-unsafe (syntax? v_0))
(let ((app_0 (->faslable (correlated-e v_0))))
(let ((app_1 (begin-unsafe (syntax-source v_0))))
(let ((app_2 (begin-unsafe (syntax-position v_0))))
(let ((app_3 (begin-unsafe (syntax-line v_0))))
(let ((app_4 (begin-unsafe (syntax-column v_0))))
(let ((app_5 (begin-unsafe (syntax-span v_0))))
(faslable-correlated2.1
app_0
app_1
app_2
app_3
app_4
app_5
(let ((lst_0
'(inferred-name
undefined-error-name
method-arity-error
compiler-hint:cross-module-inline)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_0 lst_1)
(begin
(if (pair? lst_1)
(let ((k_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((ht_1
(let ((ht_1
(let ((p_0
(begin-unsafe
(syntax-property
v_0
k_0))))
(if p_0
(hash-set
(if ht_0
ht_0
hash2610)
k_0
p_0)
ht_0))))
(values ht_1))))
(for-loop_0 ht_1 rest_0))))
ht_0))))))
(for-loop_0 #f lst_0)))))))))))
(if (hash? v_0)
(if (hash-eq? v_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value v_0 i_0))
(case-lambda
((key_0 value_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0 (->faslable key_0)))
(values
app_0
(->faslable value_0))))
(case-lambda
((key_1 val_0)
(hash-set table_0 key_1 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (hash-iterate-next v_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2610 (hash-iterate-first v_0))))
(if (hash-eqv? v_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value v_0 i_0))
(case-lambda
((key_0 value_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0 (->faslable key_0)))
(values
app_0
(->faslable value_0))))
(case-lambda
((key_1 val_0)
(hash-set table_0 key_1 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next v_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2589 (hash-iterate-first v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value v_0 i_0))
(case-lambda
((key_0 value_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0 (->faslable key_0)))
(values
app_0
(->faslable value_0))))
(case-lambda
((key_1 val_0)
(hash-set table_0 key_1 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next v_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2725 (hash-iterate-first v_0))))))
(if (correlated-linklet? v_0)
(let ((app_0 (->faslable (correlated-linklet-expr v_0))))
(faslable-correlated-linklet3.1
app_0
(->faslable (correlated-linklet-name v_0))))
v_0))))))
(define read-correlated-linklet-bundle-hash
(lambda (in_0) (faslable-> (fasl->s-exp.1 #t unsafe-undefined #f in_0))))
(define faslable->
(lambda (v_0)
(if (pair? v_0)
(let ((a_0 (faslable-> (car v_0))))
(let ((d_0 (faslable-> (cdr v_0))))
(if (if (eq? a_0 (car v_0)) (eq? d_0 (cdr v_0)) #f)
v_0
(cons a_0 d_0))))
(if (faslable-correlated? v_0)
(let ((props_0 (faslable-correlated-props v_0)))
(let ((c_0
(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))))))))))
(if props_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (c_1 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value props_0 i_0))
(case-lambda
((k_0 p_0)
(let ((c_2
(let ((c_2
(begin-unsafe
(syntax-property c_1 k_0 p_0))))
(values c_2))))
(for-loop_0
c_2
(hash-iterate-next props_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
c_1))))))
(for-loop_0 c_0 (hash-iterate-first props_0))))
c_0)))
(if (hash? v_0)
(if (hash-eq? v_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value v_0 i_0))
(case-lambda
((key_0 value_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0 (faslable-> key_0)))
(values
app_0
(faslable-> value_0))))
(case-lambda
((key_1 val_0)
(hash-set table_0 key_1 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (hash-iterate-next v_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2610 (hash-iterate-first v_0))))
(if (hash-eqv? v_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value v_0 i_0))
(case-lambda
((key_0 value_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0 (faslable-> key_0)))
(values
app_0
(faslable-> value_0))))
(case-lambda
((key_1 val_0)
(hash-set table_0 key_1 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next v_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2589 (hash-iterate-first v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value v_0 i_0))
(case-lambda
((key_0 value_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0 (faslable-> key_0)))
(values
app_0
(faslable-> value_0))))
(case-lambda
((key_1 val_0)
(hash-set table_0 key_1 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next v_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2725 (hash-iterate-first v_0))))))
(if (faslable-correlated-linklet? v_0)
(let ((expr_0 (faslable-> (faslable-correlated-linklet-expr v_0))))
(let ((name_0
(faslable-> (faslable-correlated-linklet-name v_0))))
(let ((expr_1 expr_0))
(begin-unsafe (correlated-linklet1.1 expr_1 name_0 #f)))))
v_0))))))
(define write-linklet-bundle
(lambda (b_0 as-correlated-linklet?_0 linklet-bundle->hash_0 port_0)
(begin
(write-bytes #vu8(35 126) port_0)
(write-bytes (bytes (unsafe-bytes-length version-bytes$1)) port_0)
(write-bytes version-bytes$1 port_0)
(let ((vm-bytes_0
(if as-correlated-linklet?_0
correlated-linklet-vm-bytes
vm-bytes$1)))
(begin
(write-bytes (bytes (unsafe-bytes-length vm-bytes_0)) port_0)
(write-bytes vm-bytes_0 port_0)))
(write-bytes #vu8(66) port_0)
(write-bytes (make-bytes 20 0) port_0)
(if as-correlated-linklet?_0
(write-correlated-linklet-bundle-hash
(|#%app| linklet-bundle->hash_0 b_0)
port_0)
(write-linklet-bundle-hash
(|#%app| linklet-bundle->hash_0 b_0)
port_0)))))
(define linklet-bundle->bytes
(lambda (b_0 as-correlated-linklet?_0 linklet-bundle->hash_0)
(let ((o_0 (open-output-bytes)))
(begin
(write-linklet-bundle
b_0
as-correlated-linklet?_0
linklet-bundle->hash_0
o_0)
(get-output-bytes o_0)))))
(define write-linklet-directory
(lambda (ld_0
as-correlated-linklet?_0
linklet-directory->hash_0
linklet-bundle->hash_0
port_0)
(let ((vm-bytes_0
(if as-correlated-linklet?_0
correlated-linklet-vm-bytes
vm-bytes$1)))
(begin
(write-bytes #vu8(35 126) port_0)
(begin
(write-byte (unsafe-bytes-length version-bytes$1) port_0)
(begin
(write-bytes version-bytes$1 port_0)
(begin
(write-byte (unsafe-bytes-length vm-bytes_0) port_0)
(begin
(write-bytes vm-bytes_0 port_0)
(begin
(write-bytes #vu8(68) port_0)
(letrec*
((flatten-linklet-directory_0
(|#%name|
flatten-linklet-directory
(lambda (ld_1 rev-name-prefix_0 accum_0)
(begin
(call-with-values
(lambda ()
(let ((ht_0
(|#%app| linklet-directory->hash_0 ld_1)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (accum_1 saw-bundle?_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
ht_0
i_0))
(case-lambda
((key_0 value_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(if (eq? key_0 #f)
(values
(cons
(let ((app_0
(encode-name
rev-name-prefix_0)))
(cons
app_0
(linklet-bundle->bytes
value_0
as-correlated-linklet?_0
linklet-bundle->hash_0)))
accum_1)
#t)
(values
(flatten-linklet-directory_0
value_0
(cons
key_0
rev-name-prefix_0)
accum_1)
saw-bundle?_0)))
(case-lambda
((accum_2 saw-bundle?_1)
(values
accum_2
saw-bundle?_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((accum_2 saw-bundle?_1)
(for-loop_0
accum_2
saw-bundle?_1
(hash-iterate-next
ht_0
i_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(values accum_1 saw-bundle?_0)))))))
(for-loop_0
accum_0
#f
(hash-iterate-first ht_0))))))
(case-lambda
((new-accum_0 saw-bundle?_0)
(if saw-bundle?_0
new-accum_0
(cons
(cons (encode-name rev-name-prefix_0) #vu8(35 102))
new-accum_0)))
(args
(raise-binding-result-arity-error 2 args)))))))))
(let ((bundles_0
(list->vector
(let ((temp1_0
(flatten-linklet-directory_0 ld_0 '() '())))
(let ((temp2_0
(|#%name|
temp2
(lambda (a_0 b_0)
(begin
(let ((app_0 (car a_0)))
(bytes<? app_0 (car b_0))))))))
(let ((temp1_1 temp1_0))
(sort.1 #f #f temp1_1 temp2_0)))))))
(let ((len_0 (vector-length bundles_0)))
(let ((initial-offset_0
(+
2
1
(unsafe-bytes-length version-bytes$1)
1
(unsafe-bytes-length vm-bytes_0)
1
4)))
(begin
(write-int len_0 port_0)
(let ((btree-size_0
(compute-btree-size bundles_0 len_0)))
(let ((node-offsets_0
(compute-btree-node-offsets
bundles_0
len_0
initial-offset_0)))
(let ((bundle-offsets_0
(compute-bundle-offsets
bundles_0
len_0
(+ initial-offset_0 btree-size_0))))
(begin
(write-directory-btree
bundles_0
node-offsets_0
bundle-offsets_0
len_0
port_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (< pos_0 len_0)
(begin
(write-bytes
(cdr
(vector-ref
bundles_0
pos_0))
port_0)
(for-loop_0 (+ pos_0 1)))
(values)))))))
(for-loop_0 0)))
(void)))))))))))))))))))
(define encode-name
(lambda (rev-name_0)
(let ((encode-symbol_0
(|#%name|
encode-symbol
(lambda (s_0)
(begin
(let ((bstr_0 (string->bytes/utf-8 (symbol->string s_0))))
(let ((len_0 (unsafe-bytes-length bstr_0)))
(if (< len_0 255)
(list (bytes len_0) bstr_0)
(let ((app_0 (bytes 255)))
(list
app_0
(integer->integer-bytes len_0 4 #f #f)
bstr_0))))))))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (rev-name_1 accum_0)
(begin
(if (null? rev-name_1)
(apply bytes-append accum_0)
(let ((app_0 (cdr rev-name_1)))
(loop_0
app_0
(append (encode-symbol_0 (car rev-name_1)) accum_0)))))))))
(loop_0 rev-name_0 '())))))
(define compute-btree-size
(lambda (bundles_0 len_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_0)
(begin
(if (< pos_0 len_0)
(let ((result_1
(let ((result_1
(+
result_0
(let ((nlen_0
(unsafe-bytes-length
(car (vector-ref bundles_0 pos_0)))))
(+ nlen_0 20)))))
(values result_1))))
(for-loop_0 result_1 (+ pos_0 1)))
result_0))))))
(for-loop_0 0 0)))))
(define compute-btree-node-offsets
(lambda (bundles_0 len_0 initial-offset_0)
(let ((node-offsets_0 (make-vector len_0)))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (lo_0 hi_0 offset_0)
(begin
(if (= lo_0 hi_0)
offset_0
(let ((mid_0 (quotient (+ lo_0 hi_0) 2)))
(begin
(vector-set! node-offsets_0 mid_0 offset_0)
(let ((nlen_0
(unsafe-bytes-length
(car (vector-ref bundles_0 mid_0)))))
(let ((offset_1 (+ offset_0 4 nlen_0 4 4 4 4)))
(let ((offset_2 (loop_0 lo_0 mid_0 offset_1)))
(loop_0 (add1 mid_0) hi_0 offset_2))))))))))))
(loop_0 0 len_0 initial-offset_0))
node-offsets_0))))
(define compute-bundle-offsets
(lambda (bundles_0 len_0 offset_0)
(let ((bundle-offsets_0 (make-vector len_0)))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (i_0 offset_1)
(begin
(if (= i_0 len_0)
(void)
(begin
(vector-set! bundle-offsets_0 i_0 offset_1)
(let ((app_0 (add1 i_0)))
(loop_0
app_0
(+
offset_1
(unsafe-bytes-length
(cdr (vector-ref bundles_0 i_0)))))))))))))
(loop_0 0 offset_0))
bundle-offsets_0))))
(define write-directory-btree
(lambda (bundles_0 node-offsets_0 bundle-offsets_0 len_0 port_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (lo_0 hi_0)
(begin
(if (= lo_0 hi_0)
(void)
(let ((mid_0 (quotient (+ lo_0 hi_0) 2)))
(let ((p_0 (vector-ref bundles_0 mid_0)))
(let ((nlen_0 (unsafe-bytes-length (car p_0))))
(begin
(write-int nlen_0 port_0)
(write-bytes (car p_0) port_0)
(write-int (vector-ref bundle-offsets_0 mid_0) port_0)
(write-int (unsafe-bytes-length (cdr p_0)) port_0)
(if (> mid_0 lo_0)
(let ((left_0 (quotient (+ lo_0 mid_0) 2)))
(write-int
(vector-ref node-offsets_0 left_0)
port_0))
(write-int 0 port_0))
(if (< (add1 mid_0) hi_0)
(let ((right_0 (quotient (+ (add1 mid_0) hi_0) 2)))
(write-int
(vector-ref node-offsets_0 right_0)
port_0))
(write-int 0 port_0))
(loop_0 lo_0 mid_0)
(loop_0 (add1 mid_0) hi_0)))))))))))
(loop_0 0 len_0))))
(define write-int
(lambda (n_0 port_0)
(write-bytes (integer->integer-bytes n_0 4 #f #f) port_0)))
(define struct:linklet-directory
(make-record-type-descriptor*
'linklet-directory
#f
(|#%nongenerative-uid| linklet-directory)
#f
#f
1
0))
(define effect_2457
(struct-type-install-properties!
struct:linklet-directory
'linklet-directory
1
0
#f
(list
(cons
prop:custom-write
(lambda (ld_0 port_0 mode_0)
(write-linklet-directory
ld_0
(correlated-linklet-directory? ld_0)
linklet-directory->hash$1
linklet-bundle->hash
port_0))))
(current-inspector)
#f
'(0)
#f
'linklet-directory))
(define linklet-directory1.1
(|#%name|
linklet-directory
(record-constructor
(make-record-constructor-descriptor struct:linklet-directory #f #f))))
(define linklet-directory?$1_2352
(|#%name| linklet-directory? (record-predicate struct:linklet-directory)))
(define linklet-directory?$1
(|#%name|
linklet-directory?
(lambda (v)
(if (linklet-directory?$1_2352 v)
#t
($value
(if (impersonator? v)
(linklet-directory?$1_2352 (impersonator-val v))
#f))))))
(define linklet-directory-ht_3011
(|#%name| linklet-directory-ht (record-accessor struct:linklet-directory 0)))
(define linklet-directory-ht
(|#%name|
linklet-directory-ht
(lambda (s)
(if (linklet-directory?$1_2352 s)
(linklet-directory-ht_3011 s)
($value
(impersonate-ref
linklet-directory-ht_3011
struct:linklet-directory
0
s
'linklet-directory
'ht))))))
(define struct:linklet-bundle
(make-record-type-descriptor*
'linklet-bundle
#f
(|#%nongenerative-uid| linklet-bundle)
#f
#f
1
0))
(define effect_2330
(struct-type-install-properties!
struct:linklet-bundle
'linklet-bundle
1
0
#f
(list
(cons
prop:custom-write
(lambda (b_0 port_0 mode_0)
(write-linklet-bundle
b_0
(correlated-linklet-bundle? b_0)
linklet-bundle->hash
port_0))))
(current-inspector)
#f
'(0)
#f
'linklet-bundle))
(define linklet-bundle2.1
(|#%name|
linklet-bundle
(record-constructor
(make-record-constructor-descriptor struct:linklet-bundle #f #f))))
(define linklet-bundle?_3104
(|#%name| linklet-bundle? (record-predicate struct:linklet-bundle)))
(define linklet-bundle?
(|#%name|
linklet-bundle?
(lambda (v)
(if (linklet-bundle?_3104 v)
#t
($value
(if (impersonator? v)
(linklet-bundle?_3104 (impersonator-val v))
#f))))))
(define linklet-bundle-ht_3215
(|#%name| linklet-bundle-ht (record-accessor struct:linklet-bundle 0)))
(define linklet-bundle-ht
(|#%name|
linklet-bundle-ht
(lambda (s)
(if (linklet-bundle?_3104 s)
(linklet-bundle-ht_3215 s)
($value
(impersonate-ref
linklet-bundle-ht_3215
struct:linklet-bundle
0
s
'linklet-bundle
'ht))))))
(define hash->linklet-directory
(lambda (ht_0)
(begin
(if (if (not (impersonator? ht_0))
(if (hash? ht_0) (if (immutable? ht_0) (hash-eq? ht_0) #f) #f)
#f)
(void)
(raise-argument-error
'hash->linklet-directory
"(and/c hash? hash-eq? immutable? (not/c impersonator?))"
ht_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 v_0)
(begin
(if (not k_0)
(if (linklet-bundle? v_0)
(void)
(raise-arguments-error
'hash->linklet-directory
"value for #f key is not a linklet bundle"
"value"
v_0))
(if (symbol? k_0)
(if (linklet-directory?$1 v_0)
(void)
(raise-arguments-error
'hash->linklet-directory
"value for symbol key is not a linklet directory"
"value"
v_0))
(raise-arguments-error
'hash->linklet-directory
"key in given hash is not #f or a symbol"
"key"
k_0)))
(for-loop_0 (hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0))))
(void)
(linklet-directory1.1 ht_0))))
(define hash->linklet-bundle
(lambda (ht_0)
(begin
(if (if (not (impersonator? ht_0))
(if (hash? ht_0) (if (immutable? ht_0) (hash-eq? ht_0) #f) #f)
#f)
(void)
(raise-argument-error
'hash->linklet-bundle
"(and/c hash? hash-eq? immutable? (not/c impersonator?))"
ht_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((k_0 (hash-iterate-key ht_0 i_0)))
(begin
(if (let ((or-part_0 (symbol? k_0)))
(if or-part_0 or-part_0 (fixnum? k_0)))
(void)
(raise-arguments-error
'hash->linklet-bundle
"key in given hash is not a symbol or fixnum"
"key"
k_0))
(for-loop_0 (hash-iterate-next ht_0 i_0))))
(values)))))))
(for-loop_0 (hash-iterate-first ht_0))))
(void)
(linklet-bundle2.1 ht_0))))
(define linklet-directory->hash$1
(|#%name|
linklet-directory->hash
(lambda (ld_0)
(begin
(begin
(if (linklet-directory?$1 ld_0)
(void)
(raise-argument-error
'linklet-directory->hash
"linklet-directory?"
ld_0))
(linklet-directory-ht ld_0))))))
(define linklet-bundle->hash
(lambda (ld_0)
(begin
(if (linklet-bundle? ld_0)
(void)
(raise-argument-error 'linklet-bundle->hash "linklet-bundle?" ld_0))
(linklet-bundle-ht ld_0))))
(define correlated-linklet-directory?
(lambda (ld_0)
(let ((ht_0 (linklet-directory->hash$1 ld_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 ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((result_1
(let ((result_1
(if (not k_0)
(correlated-linklet-bundle? v_0)
(if (symbol? k_0)
(correlated-linklet-directory? v_0)
#t))))
(values result_1))))
(if (if (not
(let ((x_0 (list k_0 v_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 (hash-iterate-next ht_0 i_0))
result_1)))
(args (raise-binding-result-arity-error 2 args))))
result_0))))))
(for-loop_0 #t (hash-iterate-first ht_0)))))))
(define correlated-linklet-bundle?
(lambda (b_0)
(let ((ht_0 (linklet-bundle->hash b_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 ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((result_1
(let ((result_1 (not (linklet? v_0))))
(values result_1))))
(if (if (not
(let ((x_0 (list k_0 v_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 (hash-iterate-next ht_0 i_0))
result_1)))
(args (raise-binding-result-arity-error 2 args))))
result_0))))))
(for-loop_0 #t (hash-iterate-first ht_0)))))))
(define struct:namespace-scopes
(make-record-type-descriptor*
'namespace-scopes
#f
(structure-type-lookup-prefab-uid 'namespace-scopes #f 2 0 #f '(0 1))
#f
#f
2
3))
(define effect_2470
(struct-type-install-properties!
struct:namespace-scopes
'namespace-scopes
2
0
#f
null
'prefab
#f
'(0 1)
#f
'namespace-scopes))
(define namespace-scopes1.1
(|#%name|
namespace-scopes
(record-constructor
(make-record-constructor-descriptor struct:namespace-scopes #f #f))))
(define namespace-scopes?_2470
(|#%name| namespace-scopes? (record-predicate struct:namespace-scopes)))
(define namespace-scopes?
(|#%name|
namespace-scopes?
(lambda (v)
(if (namespace-scopes?_2470 v)
#t
($value
(if (impersonator? v)
(namespace-scopes?_2470 (impersonator-val v))
#f))))))
(define namespace-scopes-post_2810
(|#%name| namespace-scopes-post (record-accessor struct:namespace-scopes 0)))
(define namespace-scopes-post
(|#%name|
namespace-scopes-post
(lambda (s)
(if (namespace-scopes?_2470 s)
(namespace-scopes-post_2810 s)
($value
(impersonate-ref
namespace-scopes-post_2810
struct:namespace-scopes
0
s
'namespace-scopes
'post))))))
(define namespace-scopes-other_2110
(|#%name|
namespace-scopes-other
(record-accessor struct:namespace-scopes 1)))
(define namespace-scopes-other
(|#%name|
namespace-scopes-other
(lambda (s)
(if (namespace-scopes?_2470 s)
(namespace-scopes-other_2110 s)
($value
(impersonate-ref
namespace-scopes-other_2110
struct:namespace-scopes
1
s
'namespace-scopes
'other))))))
(define swap-top-level-scopes
(lambda (s_0 original-scopes-s_0 new-ns_0)
(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)))
(decode-namespace-scopes original-scopes-s_0)))
(case-lambda
((old-scs-post_0 old-scs-other_0)
(call-with-values
(lambda () (extract-namespace-scopes/values new-ns_0))
(case-lambda
((new-scs-post_0 new-scs-other_0)
(syntax-swap-scopes
(syntax-swap-scopes s_0 old-scs-post_0 new-scs-post_0)
old-scs-other_0
new-scs-other_0))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 2 args))))))
(define extract-namespace-scopes/values
(lambda (ns_0)
(let ((root-ctx_0 (namespace-get-root-expand-ctx ns_0)))
(let ((post-expansion-sc_0
(post-expansion-scope
(begin-unsafe
(root-expand-context/outer-post-expansion root-ctx_0)))))
(let ((app_0 (seteq post-expansion-sc_0)))
(values
app_0
(let ((s_0
(list->seteq
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner root-ctx_0))))))
(begin-unsafe (hash-remove s_0 post-expansion-sc_0)))))))))
(define extract-namespace-scopes
(lambda (ns_0)
(call-with-values
(lambda () (extract-namespace-scopes/values ns_0))
(case-lambda
((scs-post_0 scs-other_0) (namespace-scopes1.1 scs-post_0 scs-other_0))
(args (raise-binding-result-arity-error 2 args))))))
(define encode-namespace-scopes
(lambda (ns_0)
(call-with-values
(lambda () (extract-namespace-scopes/values ns_0))
(case-lambda
((post-expansion-scs_0 other-scs_0)
(let ((post-expansion-s_0
(let ((app_0 (datum->syntax$1 #f 'post)))
(add-scopes app_0 (set->list post-expansion-scs_0)))))
(let ((other-s_0
(let ((app_0 (datum->syntax$1 #f 'other)))
(add-scopes app_0 (set->list other-scs_0)))))
(datum->syntax$1 #f (vector post-expansion-s_0 other-s_0)))))
(args (raise-binding-result-arity-error 2 args))))))
(define decode-namespace-scopes
(lambda (stx_0)
(let ((vec_0 (syntax-e$1 stx_0)))
(let ((app_0 (syntax-scope-set (vector-ref vec_0 0) 0)))
(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)))
#f)))
(define struct:syntax-literals
(make-record-type-descriptor*
'syntax-literals
#f
(|#%nongenerative-uid| syntax-literals)
#f
#f
2
3))
(define effect_2378
(struct-type-install-properties!
struct:syntax-literals
'syntax-literals
2
0
#f
null
(current-inspector)
#f
'()
#f
'syntax-literals))
(define syntax-literals1.1
(|#%name|
syntax-literals
(record-constructor
(make-record-constructor-descriptor struct:syntax-literals #f #f))))
(define syntax-literals?_2232
(|#%name| syntax-literals? (record-predicate struct:syntax-literals)))
(define syntax-literals?
(|#%name|
syntax-literals?
(lambda (v)
(if (syntax-literals?_2232 v)
#t
($value
(if (impersonator? v)
(syntax-literals?_2232 (impersonator-val v))
#f))))))
(define syntax-literals-stxes_3121
(|#%name| syntax-literals-stxes (record-accessor struct:syntax-literals 0)))
(define syntax-literals-stxes
(|#%name|
syntax-literals-stxes
(lambda (s)
(if (syntax-literals?_2232 s)
(syntax-literals-stxes_3121 s)
($value
(impersonate-ref
syntax-literals-stxes_3121
struct:syntax-literals
0
s
'syntax-literals
'stxes))))))
(define syntax-literals-count_2487
(|#%name| syntax-literals-count (record-accessor struct:syntax-literals 1)))
(define syntax-literals-count
(|#%name|
syntax-literals-count
(lambda (s)
(if (syntax-literals?_2232 s)
(syntax-literals-count_2487 s)
($value
(impersonate-ref
syntax-literals-count_2487
struct:syntax-literals
1
s
'syntax-literals
'count))))))
(define set-syntax-literals-stxes!_3052
(|#%name|
set-syntax-literals-stxes!
(record-mutator struct:syntax-literals 0)))
(define set-syntax-literals-stxes!
(|#%name|
set-syntax-literals-stxes!
(lambda (s v)
(if (syntax-literals?_2232 s)
(set-syntax-literals-stxes!_3052 s v)
($value
(impersonate-set!
set-syntax-literals-stxes!_3052
struct:syntax-literals
0
0
s
v
'syntax-literals
'stxes))))))
(define set-syntax-literals-count!_3102
(|#%name|
set-syntax-literals-count!
(record-mutator struct:syntax-literals 1)))
(define set-syntax-literals-count!
(|#%name|
set-syntax-literals-count!
(lambda (s v)
(if (syntax-literals?_2232 s)
(set-syntax-literals-count!_3102 s v)
($value
(impersonate-set!
set-syntax-literals-count!_3102
struct:syntax-literals
1
1
s
v
'syntax-literals
'count))))))
(define struct:header
(make-record-type-descriptor*
'header
#f
(|#%nongenerative-uid| header)
#f
#f
8
36))
(define effect_2959
(struct-type-install-properties!
struct:header
'header
8
0
#f
null
(current-inspector)
#f
'(0 1 3 4 6 7)
#f
'header))
(define header2.1
(|#%name|
header
(record-constructor
(make-record-constructor-descriptor struct:header #f #f))))
(define header?_3140 (|#%name| header? (record-predicate struct:header)))
(define header?
(|#%name|
header?
(lambda (v)
(if (header?_3140 v)
#t
($value
(if (impersonator? v) (header?_3140 (impersonator-val v)) #f))))))
(define header-module-path-indexes_3364
(|#%name| header-module-path-indexes (record-accessor struct:header 0)))
(define header-module-path-indexes
(|#%name|
header-module-path-indexes
(lambda (s)
(if (header?_3140 s)
(header-module-path-indexes_3364 s)
($value
(impersonate-ref
header-module-path-indexes_3364
struct:header
0
s
'header
'module-path-indexes))))))
(define header-binding-sym-to-define-sym_2390
(|#%name|
header-binding-sym-to-define-sym
(record-accessor struct:header 1)))
(define header-binding-sym-to-define-sym
(|#%name|
header-binding-sym-to-define-sym
(lambda (s)
(if (header?_3140 s)
(header-binding-sym-to-define-sym_2390 s)
($value
(impersonate-ref
header-binding-sym-to-define-sym_2390
struct:header
1
s
'header
'binding-sym-to-define-sym))))))
(define header-binding-syms-in-order_2365
(|#%name| header-binding-syms-in-order (record-accessor struct:header 2)))
(define header-binding-syms-in-order
(|#%name|
header-binding-syms-in-order
(lambda (s)
(if (header?_3140 s)
(header-binding-syms-in-order_2365 s)
($value
(impersonate-ref
header-binding-syms-in-order_2365
struct:header
2
s
'header
'binding-syms-in-order))))))
(define header-require-var-to-import-sym_2845
(|#%name|
header-require-var-to-import-sym
(record-accessor struct:header 3)))
(define header-require-var-to-import-sym
(|#%name|
header-require-var-to-import-sym
(lambda (s)
(if (header?_3140 s)
(header-require-var-to-import-sym_2845 s)
($value
(impersonate-ref
header-require-var-to-import-sym_2845
struct:header
3
s
'header
'require-var-to-import-sym))))))
(define header-import-sym-to-extra-inspectors_2352
(|#%name|
header-import-sym-to-extra-inspectors
(record-accessor struct:header 4)))
(define header-import-sym-to-extra-inspectors
(|#%name|
header-import-sym-to-extra-inspectors
(lambda (s)
(if (header?_3140 s)
(header-import-sym-to-extra-inspectors_2352 s)
($value
(impersonate-ref
header-import-sym-to-extra-inspectors_2352
struct:header
4
s
'header
'import-sym-to-extra-inspectors))))))
(define header-require-vars-in-order_2218
(|#%name| header-require-vars-in-order (record-accessor struct:header 5)))
(define header-require-vars-in-order
(|#%name|
header-require-vars-in-order
(lambda (s)
(if (header?_3140 s)
(header-require-vars-in-order_2218 s)
($value
(impersonate-ref
header-require-vars-in-order_2218
struct:header
5
s
'header
'require-vars-in-order))))))
(define header-define-and-import-syms_2444
(|#%name| header-define-and-import-syms (record-accessor struct:header 6)))
(define header-define-and-import-syms
(|#%name|
header-define-and-import-syms
(lambda (s)
(if (header?_3140 s)
(header-define-and-import-syms_2444 s)
($value
(impersonate-ref
header-define-and-import-syms_2444
struct:header
6
s
'header
'define-and-import-syms))))))
(define header-syntax-literals_3129
(|#%name| header-syntax-literals (record-accessor struct:header 7)))
(define header-syntax-literals
(|#%name|
header-syntax-literals
(lambda (s)
(if (header?_3140 s)
(header-syntax-literals_3129 s)
($value
(impersonate-ref
header-syntax-literals_3129
struct:header
7
s
'header
'syntax-literals))))))
(define set-header-binding-syms-in-order!_2287
(|#%name|
set-header-binding-syms-in-order!
(record-mutator struct:header 2)))
(define set-header-binding-syms-in-order!
(|#%name|
set-header-binding-syms-in-order!
(lambda (s v)
(if (header?_3140 s)
(set-header-binding-syms-in-order!_2287 s v)
($value
(impersonate-set!
set-header-binding-syms-in-order!_2287
struct:header
2
2
s
v
'header
'binding-syms-in-order))))))
(define set-header-require-vars-in-order!_2994
(|#%name|
set-header-require-vars-in-order!
(record-mutator struct:header 5)))
(define set-header-require-vars-in-order!
(|#%name|
set-header-require-vars-in-order!
(lambda (s v)
(if (header?_3140 s)
(set-header-require-vars-in-order!_2994 s v)
($value
(impersonate-set!
set-header-require-vars-in-order!_2994
struct:header
5
5
s
v
'header
'require-vars-in-order))))))
(define struct:variable-use
(make-record-type-descriptor*
'variable-use
#f
(|#%nongenerative-uid| variable-use)
#f
#f
2
0))
(define effect_2316
(struct-type-install-properties!
struct:variable-use
'variable-use
2
0
#f
null
#f
#f
'(0 1)
#f
'variable-use))
(define variable-use3.1
(|#%name|
variable-use
(record-constructor
(make-record-constructor-descriptor struct:variable-use #f #f))))
(define variable-use?_2270
(|#%name| variable-use? (record-predicate struct:variable-use)))
(define variable-use?
(|#%name|
variable-use?
(lambda (v)
(if (variable-use?_2270 v)
#t
($value
(if (impersonator? v)
(variable-use?_2270 (impersonator-val v))
#f))))))
(define variable-use-module-use_2672
(|#%name| variable-use-module-use (record-accessor struct:variable-use 0)))
(define variable-use-module-use
(|#%name|
variable-use-module-use
(lambda (s)
(if (variable-use?_2270 s)
(variable-use-module-use_2672 s)
($value
(impersonate-ref
variable-use-module-use_2672
struct:variable-use
0
s
'variable-use
'module-use))))))
(define variable-use-sym_2257
(|#%name| variable-use-sym (record-accessor struct:variable-use 1)))
(define variable-use-sym
(|#%name|
variable-use-sym
(lambda (s)
(if (variable-use?_2270 s)
(variable-use-sym_2257 s)
($value
(impersonate-ref
variable-use-sym_2257
struct:variable-use
1
s
'variable-use
'sym))))))
(define make-syntax-literals (lambda () (syntax-literals1.1 null 0)))
(define make-header
(lambda (mpis_0 syntax-literals_0)
(let ((app_0 (make-hasheq)))
(let ((app_1 (begin-unsafe (make-hash))))
(let ((app_2 (make-hasheq)))
(header2.1
mpis_0
app_0
null
app_1
app_2
null
(make-hasheq)
syntax-literals_0))))))
(define make-variable-uses (lambda () (make-hash)))
(define add-syntax-literal!
(lambda (header-or-literals_0 q_0)
(let ((sl_0
(if (header? header-or-literals_0)
(header-syntax-literals header-or-literals_0)
header-or-literals_0)))
(let ((pos_0 (syntax-literals-count sl_0)))
(begin
(set-syntax-literals-count! sl_0 (add1 pos_0))
(set-syntax-literals-stxes!
sl_0
(cons q_0 (syntax-literals-stxes sl_0)))
pos_0)))))
(define add-syntax-literals!
(lambda (sl_0 vec_0)
(let ((pos_0 (syntax-literals-count sl_0)))
(begin
(call-with-values
(lambda ()
(begin
(check-vector vec_0)
(values vec_0 (unsafe-vector-length vec_0))))
(case-lambda
((vec_1 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_1)
(begin
(if (unsafe-fx< pos_1 len_0)
(let ((e_0 (unsafe-vector-ref vec_1 pos_1)))
(begin
(add-syntax-literal! sl_0 e_0)
(for-loop_0 (unsafe-fx+ 1 pos_1))))
(values)))))))
(for-loop_0 0))))
(args (raise-binding-result-arity-error 2 args))))
(void)
(cons pos_0 (vector-length vec_0))))))
(define syntax-literals-empty?
(lambda (sl_0) (null? (syntax-literals-stxes sl_0))))
(define generate-lazy-syntax-literals!.1
(|#%name|
generate-lazy-syntax-literals!
(lambda (skip-deserialize?4_0 sl6_0 mpis7_0 self8_0)
(begin
(let ((app_0 (list syntax-literals-id)))
(let ((app_1
(list
'define-values
app_0
(list* 'make-vector (syntax-literals-count sl6_0) '(#f)))))
(list
app_1
(let ((app_2 (list get-syntax-literal!-id)))
(list
'define-values
app_2
(list
'lambda
'(pos)
(let ((app_3
(list
(list
'(ready-stx)
(list*
'unsafe-vector*-ref
syntax-literals-id
'(pos))))))
(list
'let-values
app_3
(list
'if
'ready-stx
'ready-stx
(list*
'begin
(let ((app_4
(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_4
(list
(let ((app_5
(list
(list
'(stx)
(let ((app_5
(list
'syntax-shift-phase-level
(list*
'unsafe-vector*-ref
deserialized-syntax-vector-id
'(pos))
phase-shift-id)))
(list
'syntax-module-path-index-shift
app_5
(add-module-path-index! mpis7_0 self8_0)
self-id
inspector-id))))))
(list
'let-values
app_5
(list*
'letrec-values
(list
(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
(let ((app_0 (list deserialize-syntax-id)))
(list
'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!
(lambda (sl_0 mpis_0 base-phase_0 self_0 ns_0)
(if (begin-unsafe (null? (syntax-literals-stxes sl_0)))
#f
(let ((app_0
(list
(list
'(ns+stxss)
(let ((temp23_0
(let ((app_0 (encode-namespace-scopes ns_0)))
(cons
app_0
(reverse$1 (syntax-literals-stxes sl_0))))))
(generate-deserialize.1 #t temp23_0 mpis_0))))))
(list
'let-values
app_0
(list
'let-values
'(((ns-scope-s) (car ns+stxss)))
(list
'list->vector
(list*
'map
(list
'lambda
'(stx)
(list
'swap-top-level-scopes
(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))))))))))
(define generate-eager-syntax-literal-lookup
(lambda (pos_0) (list 'unsafe-vector*-ref syntax-literals-id pos_0)))
(define syntax-literals-as-vector
(lambda (sl_0) (list->vector (reverse$1 (syntax-literals-stxes sl_0)))))
(define select-fresh
(lambda (sym_0 header_0)
(if (symbol-conflicts? sym_0 header_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (pos_0)
(begin
(let ((new-sym_0
(string->symbol
(let ((app_0 (number->string pos_0)))
(string-append app_0 "/" (symbol->string sym_0))))))
(if (symbol-conflicts? new-sym_0 header_0)
(loop_0 (add1 pos_0))
new-sym_0)))))))
(loop_0 1))
sym_0)))
(define symbol-conflicts?
(lambda (sym_0 header_0)
(let ((or-part_0 (begin-unsafe (hash-ref built-in-symbols sym_0 #f))))
(if or-part_0
or-part_0
(hash-ref (header-define-and-import-syms header_0) sym_0 #f)))))
(define register-required-variable-use!.1
(|#%name|
register-required-variable-use!
(lambda (defined?10_0
header12_0
mpi13_0
phase14_0
sym15_0
extra-inspector16_0)
(begin
(let ((key_0
(variable-use3.1 (module-use1.1 mpi13_0 phase14_0) sym15_0)))
(let ((variable-uses_0 (header-require-var-to-import-sym header12_0)))
(let ((prev-var-sym_0 (hash-ref variable-uses_0 key_0 #f)))
(let ((var-sym_0
(if prev-var-sym_0
prev-var-sym_0
(let ((sym_0
(select-fresh
(variable-use-sym key_0)
header12_0)))
(begin
(hash-set! variable-uses_0 key_0 sym_0)
(set-header-require-vars-in-order!
header12_0
(cons
key_0
(header-require-vars-in-order header12_0)))
(let ((app_0
(header-define-and-import-syms header12_0)))
(hash-set!
app_0
sym_0
(if defined?10_0 'defined 'required)))
sym_0)))))
(begin
(if (if extra-inspector16_0 (not prev-var-sym_0) #f)
(let ((extra-inspectors_0
(header-import-sym-to-extra-inspectors header12_0)))
(let ((xform_0
(lambda (s_0)
(begin-unsafe
(hash-set s_0 extra-inspector16_0 #t)))))
(let ((default_0 hash2610))
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
extra-inspectors_0
var-sym_0
xform_0
default_0)))))
(void))
var-sym_0)))))))))
(define register-as-defined!
(lambda (header_0 def-sym_0)
(hash-set! (header-define-and-import-syms header_0) def-sym_0 'defined)))
(define registered-as-required?
(lambda (header_0 var-sym_0)
(eq?
'required
(hash-ref (header-define-and-import-syms header_0) var-sym_0 #f))))
(define generate-links+imports
(lambda (header_0 phase_0 cctx_0 cross-linklet-inlining?_0)
(call-with-values
(lambda ()
(let ((lst_0 (header-require-vars-in-order header_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_0 link-mod-uses_0 lst_1)
(begin
(if (pair? lst_1)
(let ((vu_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((mu_0 (variable-use-module-use vu_0)))
(if (let ((or-part_0 (hash-ref ht_0 mu_0 #f)))
(if or-part_0
or-part_0
(let ((or-part_1
(eq?
(module-use-module mu_0)
(compile-context-self
cctx_0))))
(if or-part_1
or-part_1
(let ((mpi_0
(module-use-module mu_0)))
(begin-unsafe
(eq?
top-level-module-path-index
mpi_0)))))))
(values ht_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))
(args
(raise-binding-result-arity-error 2 args)))))
(case-lambda
((ht_1 link-mod-uses_1)
(for-loop_0 ht_1 link-mod-uses_1 rest_0))
(args (raise-binding-result-arity-error 2 args))))))
(values ht_0 link-mod-uses_0)))))))
(for-loop_0 hash2725 null lst_0)))))
(case-lambda
((mod-use-ht_0 link-mod-uses_0)
(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 ((mu_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(reverse$1
(let ((lst_1
(header-require-vars-in-order
header_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_2)
(begin
(if (pair? lst_2)
(let ((vu_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((fold-var_2
(if (equal?
mu_0
(variable-use-module-use
vu_0))
(let ((fold-var_2
(cons
(let ((var-sym_0
(hash-ref
(header-require-var-to-import-sym
header_0)
vu_0)))
(let ((ex-sym_0
(variable-use-sym
vu_0)))
(if (eq?
var-sym_0
ex-sym_0)
var-sym_0
(list
ex-sym_0
var-sym_0))))
fold-var_1)))
(values
fold-var_2))
fold-var_1)))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1 null lst_1)))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null link-mod-uses_0))))))
(let ((app_1
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((mu_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((extra-inspectorss_0
(let ((lst_1
(header-require-vars-in-order
header_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_0
lst_2)
(begin
(if (pair?
lst_2)
(let ((vu_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((table_1
(if (equal?
mu_0
(variable-use-module-use
vu_0))
(let ((var-sym_0
(hash-ref
(header-require-var-to-import-sym
header_0)
vu_0)))
(begin
#t
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(let ((extra-inspectors_0
(hash-ref
(header-import-sym-to-extra-inspectors
header_0)
var-sym_0
#f)))
(begin
#t
(letrec*
((for-loop_3
(|#%name|
for-loop
(lambda (table_2)
(begin
(let ((table_3
(if (if extra-inspectors_0
extra-inspectors_0
cross-linklet-inlining?_0)
(let ((table_3
(call-with-values
(lambda ()
(values
var-sym_0
extra-inspectors_0))
(case-lambda
((key_0
val_0)
(hash-set
table_2
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_3))
table_2)))
table_3))))))
(for-loop_3
table_1))))))
table_2))))))
(for-loop_2
table_0))))
table_0)))
(for-loop_1
table_1
rest_1))))
table_0))))))
(for-loop_1
hash2725
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))))
fold-var_0))))))
(for-loop_0 null link-mod-uses_0))))))
(values
link-mod-uses_0
app_0
app_1
(reverse$1
(let ((lst_0 (header-require-vars-in-order header_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((vu_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(if (let ((mod_0
(module-use-module
(variable-use-module-use
vu_0))))
(let ((or-part_0
(eq?
mod_0
(compile-context-self
cctx_0))))
(if or-part_0
or-part_0
(begin-unsafe
(eq?
top-level-module-path-index
mod_0)))))
(let ((fold-var_1
(cons
(let ((var-sym_0
(hash-ref
(header-require-var-to-import-sym
header_0)
vu_0)))
(let ((ex-sym_0
(variable-use-sym
vu_0)))
(if (eq?
var-sym_0
ex-sym_0)
var-sym_0
(list
var-sym_0
ex-sym_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 lst_0)))))))))
(args (raise-binding-result-arity-error 2 args))))))
(define instance-imports
(list
ns-id
phase-shift-id
self-id
inspector-id
bulk-binding-registry-id
set-transformer!-id))
(define make-instance-instance.1
(|#%name|
make-instance-instance
(lambda (bulk-binding-registry5_0
inspector4_0
namespace1_0
phase-shift2_0
self3_0
set-transformer!6_0)
(begin
(make-instance
'instance
#f
'constant
ns-id
namespace1_0
phase-shift-id
phase-shift2_0
self-id
self3_0
inspector-id
inspector4_0
bulk-binding-registry-id
bulk-binding-registry5_0
set-transformer!-id
set-transformer!6_0)))))
(define make-module-body-instance-instance.1
(|#%name|
make-module-body-instance-instance
(lambda (set-transformer!14_0)
(begin
(make-instance
'body-instance
#f
'constant
set-transformer!-id
set-transformer!14_0)))))
(define empty-syntax-literals-instance
(make-instance
'empty-stx
#f
'constant
get-syntax-literal!-id
(lambda (pos_0) #f)
'get-encoded-root-expand-ctx
#f))
(define effect_2427
(begin
(void
(instance-describe-variable!
empty-syntax-literals-instance
get-syntax-literal!-id
'(procedure/succeeds 2)))
(void)))
(define empty-module-body-instance
(let ((temp17_0 (lambda (name_0 val_0) (void))))
(make-module-body-instance-instance.1 temp17_0)))
(define effect_2309
(begin
(void
(instance-describe-variable!
empty-module-body-instance
set-transformer!-id
'(procedure/succeeds 4)))
(void)))
(define empty-top-syntax-literal-instance
(make-instance
'top-syntax-literal
#f
'constant
mpi-vector-id
#f
syntax-literals-id
#f))
(define empty-syntax-literals-data-instance
(make-instance
'empty-stx-data
#f
'constant
deserialized-syntax-vector-id
(vector)
deserialize-syntax-id
void))
(define empty-instance-instance (make-instance-instance.1 #f #f #f #f #f #f))
(define eager-instance-imports
(list*
ns-id
dest-phase-id
self-id
bulk-binding-registry-id
inspector-id
'(swap-top-level-scopes)))
(define make-eager-instance-instance.1
(|#%name|
make-eager-instance-instance
(lambda (bulk-binding-registry4_0
dest-phase2_0
inspector5_0
namespace1_0
self3_0)
(begin
(make-instance
'instance
#f
'constant
ns-id
namespace1_0
dest-phase-id
dest-phase2_0
self-id
self3_0
bulk-binding-registry-id
bulk-binding-registry4_0
inspector-id
inspector5_0
'swap-top-level-scopes
swap-top-level-scopes)))))
(define empty-eager-instance-instance
(make-eager-instance-instance.1 #f #f #f #f #f))
(define self-quoting-in-linklet?
(lambda (datum_0)
(let ((or-part_0 (number? datum_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (boolean? datum_0)))
(if or-part_1
or-part_1
(let ((or-part_2 (string? datum_0)))
(if or-part_2 or-part_2 (bytes? datum_0)))))))))
(define srcloc->vector
(lambda (s_0)
(if s_0
(let ((app_0 (srcloc-source s_0)))
(let ((app_1 (srcloc-line s_0)))
(let ((app_2 (srcloc-column s_0)))
(let ((app_3 (srcloc-position s_0)))
(vector app_0 app_1 app_2 app_3 (srcloc-span s_0))))))
#f)))
(define keep-source-locations? #f)
(define correlate*
(lambda (stx_0 s-exp_0)
(if (syntax-srcloc stx_0)
(datum->correlated s-exp_0 (srcloc->vector (syntax-srcloc stx_0)))
s-exp_0)))
(define correlate~ (lambda (stx_0 s-exp_0) s-exp_0))
(define correlate/app
(lambda (stx_0 s-exp_0)
(if keep-source-locations?
(correlate* stx_0 s-exp_0)
(begin-unsafe s-exp_0))))
(define ->correlated (lambda (s_0) (datum->correlated s_0 #f)))
(define correlate-source-name
(lambda (sym_0 e-sym_0)
(if (eq? sym_0 e-sym_0)
sym_0
(let ((e_0 (datum->correlated sym_0 #f)))
(begin-unsafe (syntax-property e_0 'source-name e-sym_0))))))
(define compile-keep-source-locations!
(lambda (on?_0) (set! keep-source-locations? on?_0)))
(define compile$2
(let ((compile_0
(|#%name|
compile
(lambda (p3_0 cctx4_0 name1_0 result-used?2_0)
(begin
(let ((compile_0
(|#%name|
compile
(lambda (p_0 name_0 result-used?_0)
(begin
(compile$2 p_0 cctx4_0 name_0 result-used?_0))))))
(let ((s_0 (parsed-s p3_0)))
(if (parsed-id? p3_0)
(compile-identifier.1 #f #f p3_0 cctx4_0)
(if (parsed-lambda? p3_0)
(if result-used?2_0
(add-lambda-properties
(correlate*
s_0
(list*
'lambda
(let ((formals_0 (parsed-lambda-keys p3_0)))
(let ((bodys_0 (parsed-lambda-body p3_0)))
(begin-unsafe
(list
formals_0
(compile-sequence bodys_0 cctx4_0 #f #t)))))))
name1_0
s_0)
(let ((s-exp_0 ''unused-lambda))
(begin-unsafe s-exp_0)))
(if (parsed-case-lambda? p3_0)
(if result-used?2_0
(add-lambda-properties
(correlate*
s_0
(list*
'case-lambda
(reverse$1
(let ((lst_0 (parsed-case-lambda-clauses p3_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((clause_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((formals_0
(car
clause_0)))
(let ((bodys_0
(cadr
clause_0)))
(let ((formals_1
formals_0))
(begin-unsafe
(list
formals_1
(compile-sequence
bodys_0
cctx4_0
#f
#t))))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
name1_0
s_0)
(let ((s-exp_0 ''unused-case-lambda))
(begin-unsafe s-exp_0)))
(if (parsed-app? p3_0)
(let ((rands_0 (parsed-app-rands p3_0)))
(correlate/app
s_0
(let ((app_0
(let ((p_0 (parsed-app-rator p3_0)))
(begin-unsafe
(begin
(compile$2 p_0 cctx4_0 #f #t))))))
(cons
app_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((r_0 (unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin-unsafe
(begin
(compile$2
r_0
cctx4_0
#f
#t)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null rands_0))))))))
(if (parsed-if? 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_1 (parsed-if-thn p3_0)))
(begin-unsafe
(begin
(compile$2
p_1
cctx4_0
name1_0
result-used?2_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
(let ((p_0
(parsed-with-continuation-mark-key
p3_0)))
(begin-unsafe
(begin
(compile$2
p_0
cctx4_0
#f
#t))))))
(let ((app_1
(let ((p_0
(parsed-with-continuation-mark-val
p3_0)))
(begin-unsafe
(begin
(compile$2
p_0
cctx4_0
#f
#t))))))
(list
'with-continuation-mark
app_0
app_1
(let ((p_0
(parsed-with-continuation-mark-body
p3_0)))
(begin-unsafe
(begin
(compile$2
p_0
cctx4_0
name1_0
result-used?2_0)))))))))
(begin-unsafe s-exp_0))
(if (parsed-begin0? p3_0)
(let ((s-exp_0
(let ((app_0
(let ((p_0
(car
(parsed-begin0-body
p3_0))))
(begin-unsafe
(begin
(compile$2
p_0
cctx4_0
name1_0
result-used?2_0))))))
(list*
'begin0
app_0
(reverse$1
(let ((lst_0
(cdr
(parsed-begin0-body p3_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((e_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin-unsafe
(begin
(compile$2
e_0
cctx4_0
#f
#f)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))))
(begin-unsafe s-exp_0))
(if (parsed-begin? p3_0)
(let ((s-exp_0
(compile-begin
(parsed-begin-body p3_0)
cctx4_0
name1_0
result-used?2_0)))
(begin-unsafe s-exp_0))
(if (parsed-set!? p3_0)
(let ((temp21_0 (parsed-set!-id p3_0)))
(let ((s-exp_0
(let ((temp24_0
(let ((p_0
(parsed-set!-rhs
p3_0)))
(let ((name_0
(parsed-s
(parsed-set!-id
p3_0))))
(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)))
(if (parsed-let-values? p3_0)
(compile-let.1
#f
p3_0
cctx4_0
name1_0
result-used?2_0)
(if (parsed-letrec-values? p3_0)
(compile-let.1
#t
p3_0
cctx4_0
name1_0
result-used?2_0)
(if (parsed-quote? p3_0)
(let ((datum_0
(parsed-quote-datum p3_0)))
(if (self-quoting-in-linklet?
datum_0)
(begin-unsafe datum_0)
(let ((s-exp_0
(list 'quote datum_0)))
(begin-unsafe s-exp_0))))
(if (parsed-quote-syntax? p3_0)
(if result-used?2_0
(compile-quote-syntax
(parsed-quote-syntax-datum p3_0)
cctx4_0)
(let ((s-exp_0 ''syntax))
(begin-unsafe s-exp_0)))
(if (|parsed-#%variable-reference?|
p3_0)
(let ((id_0
(|parsed-#%variable-reference-id|
p3_0)))
(let ((s-exp_0
(if id_0
(list
'|#%variable-reference|
(compile-identifier.1
#f
#f
id_0
cctx4_0))
'(|#%variable-reference|))))
(begin-unsafe s-exp_0)))
(error
"unrecognized parsed form:"
p3_0))))))))))))))))))))))
(|#%name|
compile
(case-lambda
((p_0 cctx_0) (begin (compile_0 p_0 cctx_0 #f #t)))
((p_0 cctx_0 name_0 result-used?2_0)
(compile_0 p_0 cctx_0 name_0 result-used?2_0))
((p_0 cctx_0 name1_0) (compile_0 p_0 cctx_0 name1_0 #t))))))
(define compile-lambda
(lambda (formals_0 bodys_0 cctx_0)
(list formals_0 (compile-sequence bodys_0 cctx_0 #f #t))))
(define compile-sequence
(lambda (bodys_0 cctx_0 name_0 result-used?_0)
(if (null? (cdr bodys_0))
(compile$2 (car bodys_0) cctx_0 name_0 result-used?_0)
(compile-begin bodys_0 cctx_0 name_0 result-used?_0))))
(define compile-begin
(lambda (es_0 cctx_0 name_0 result-used?_0)
(let ((used-pos_0 (sub1 (length es_0))))
(list*
'begin
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((used?_0 (= pos_0 used-pos_0)))
(let ((app_0 (if used?_0 name_0 #f)))
(compile$2
e_0
cctx_0
app_0
(if used?_0 result-used?_0 #f))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0 (+ pos_0 1)))))
fold-var_0))))))
(for-loop_0 null es_0 0))))))))
(define add-lambda-properties
(lambda (s_0 inferred-name_0 orig-s_0)
(letrec*
((simplify-name_0
(|#%name|
simplify-name
(lambda (v_0)
(begin
(if (pair? v_0)
(let ((n1_0 (simplify-name_0 (car v_0))))
(let ((n2_0 (simplify-name_0 (cdr v_0))))
(if (eq? n1_0 n2_0) n1_0 v_0)))
v_0))))))
(let ((name_0
(let ((or-part_0
(let ((v_0
(simplify-name_0
(syntax-property$1 orig-s_0 'inferred-name))))
(if (let ((or-part_0 (symbol? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(if (syntax?$1 v_0)
(symbol? (syntax-e$1 v_0))
#f)))
(if or-part_1 or-part_1 (void? v_0)))))
v_0
#f))))
(if or-part_0 or-part_0 inferred-name_0))))
(let ((named-s_0
(if name_0
(let ((e_0 (begin-unsafe (datum->correlated s_0 #f))))
(let ((v_0
(if (syntax?$1 name_0) (syntax-e$1 name_0) name_0)))
(let ((e_1 e_0))
(begin-unsafe
(syntax-property e_1 'inferred-name v_0)))))
s_0)))
(let ((as-method_0 (syntax-property$1 orig-s_0 'method-arity-error)))
(if as-method_0
(let ((e_0 (begin-unsafe (datum->correlated named-s_0 #f))))
(begin-unsafe
(syntax-property e_0 'method-arity-error as-method_0)))
named-s_0)))))))
(define compile-let.1
(|#%name|
compile-let
(lambda (rec?5_0 p7_0 cctx8_0 name9_0 result-used?10_0)
(begin
(let ((body_0 (parsed-let_-values-body p7_0)))
(let ((stx_0 (parsed-s p7_0)))
(let ((s-exp_0
(let ((app_0 (if rec?5_0 'letrec-values 'let-values)))
(let ((app_1
(reverse$1
(let ((lst_0 (parsed-let_-values-clauses p7_0)))
(let ((lst_1 (parsed-let_-values-idss p7_0)))
(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 ((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
(compile-sequence
body_0
cctx8_0
name9_0
result-used?10_0))))))
(let ((stx_1 stx_0)) (begin-unsafe s-exp_0)))))))))
(define add-undefined-error-name-property
(lambda (sym_0 orig-id_0)
(let ((id_0 (begin-unsafe sym_0)))
(let ((e_0 (begin-unsafe (datum->correlated id_0 #f))))
(let ((v_0
(let ((or-part_0
(syntax-property$1 orig-id_0 'undefined-error-name)))
(if or-part_0 or-part_0 (syntax-e$1 orig-id_0)))))
(let ((e_1 e_0))
(begin-unsafe
(syntax-property e_1 'undefined-error-name v_0))))))))
(define compile-identifier.1
(|#%name|
compile-identifier
(lambda (set-to13_0 set-to?12_0 p16_0 cctx17_0)
(begin
(let ((normal-b_0 (parsed-id-binding p16_0)))
(let ((b_0
(if normal-b_0
normal-b_0
(let ((temp37_0 (compile-context-self cctx17_0)))
(let ((temp38_0 (compile-context-phase cctx17_0)))
(let ((temp39_0 (syntax-e$1 (parsed-s p16_0))))
(let ((temp38_1 temp38_0) (temp37_1 temp37_0))
(make-module-binding.1
#f
null
#f
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
temp37_1
temp38_1
temp39_0))))))))
(let ((sym_0
(if (local-binding? b_0)
(local-binding-key b_0)
(if (module-binding? b_0)
(let ((mpi_0
(if (parsed-top-id? p16_0)
(compile-context-self cctx17_0)
(module-binding-module b_0))))
(if (parsed-primitive-id? p16_0)
(begin
(if (zero? (module-binding-phase b_0))
(void)
(error
"internal error: non-zero phase for a primitive"))
(if set-to?12_0
(error
"internal error: cannot assign to a primitive:"
(module-binding-sym b_0))
(void))
(module-binding-sym b_0))
(let ((c1_0
(if (eq?
mpi_0
(compile-context-module-self cctx17_0))
(let ((app_0
(header-binding-sym-to-define-sym
(compile-context-header cctx17_0))))
(hash-ref
app_0
(module-binding-sym b_0)
#f))
#f)))
(if c1_0
c1_0
(let ((temp40_0
(compile-context-header cctx17_0)))
(let ((temp41_0
(if (inside-module-context?
mpi_0
(compile-context-self cctx17_0))
(compile-context-self cctx17_0)
mpi_0)))
(let ((temp42_0 (module-binding-phase b_0)))
(let ((temp43_0 (module-binding-sym b_0)))
(let ((temp44_0
(let ((or-part_0
(module-binding-extra-inspector
b_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(parsed-id-inspector
p16_0)))
(if or-part_1
or-part_1
(if (parsed-s p16_0)
(syntax-inspector
(parsed-s p16_0))
#f)))))))
(let ((temp43_1 temp43_0)
(temp42_1 temp42_0)
(temp41_1 temp41_0)
(temp40_1 temp40_0))
(register-required-variable-use!.1
#f
temp40_1
temp41_1
temp42_1
temp43_1
temp44_0)))))))))))
(error
"not a reference to a module or local binding:"
b_0
(parsed-s p16_0))))))
(let ((stx_0 (parsed-s p16_0)))
(let ((s-exp_0
(if set-to?12_0 (list 'set! sym_0 set-to13_0) sym_0)))
(let ((stx_1 stx_0)) (begin-unsafe s-exp_0)))))))))))
(define compile-quote-syntax
(lambda (q_0 cctx_0)
(let ((pos_0 (add-syntax-literal! (compile-context-header cctx_0) q_0)))
(if (compile-context-lazy-syntax-literals? cctx_0)
(begin-unsafe (list get-syntax-literal!-id pos_0))
(begin-unsafe (list 'unsafe-vector*-ref syntax-literals-id pos_0))))))
(define extra-inspectors-allow?
(lambda (extra-inspectors_0 guard-insp_0)
(if (not extra-inspectors_0)
#f
(if (begin-unsafe (hash? extra-inspectors_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 i_0)
(begin
(if i_0
(let ((extra-insp_0
(unsafe-immutable-hash-iterate-key
extra-inspectors_0
i_0)))
(let ((result_1
(let ((result_1
(inspector-superior?
extra-insp_0
guard-insp_0)))
(values result_1))))
(if (if (not
(let ((x_0 (list extra-insp_0)))
(not result_1)))
#t
#f)
(for-loop_0
result_1
(unsafe-immutable-hash-iterate-next
extra-inspectors_0
i_0))
result_1)))
result_0))))))
(for-loop_0
#t
(unsafe-immutable-hash-iterate-first extra-inspectors_0))))
(if (procedure? extra-inspectors_0)
(|#%app| extra-inspectors_0 guard-insp_0)
(error
'extra-inspectors-allow?
"unknown representation of extra inspectors: ~e"
extra-inspectors_0))))))
(define extra-inspectors-merge
(lambda (extra-inspectors-1_0 extra-inspectors-2_0)
(if (let ((or-part_0 (not extra-inspectors-1_0)))
(if or-part_0 or-part_0 (not extra-inspectors-2_0)))
#f
(if (if (begin-unsafe (hash? extra-inspectors-1_0))
(begin-unsafe (hash? extra-inspectors-2_0))
#f)
(set-union extra-inspectors-1_0 extra-inspectors-2_0)
(lambda (guard-insp_0)
(if (extra-inspectors-allow? extra-inspectors-1_0 guard-insp_0)
(extra-inspectors-allow? extra-inspectors-2_0 guard-insp_0)
#f))))))
(define struct:module-use*
(make-record-type-descriptor*
'module-use*
struct:module-use
(|#%nongenerative-uid| module-use*)
#f
#f
2
3))
(define effect_2308
(struct-type-install-properties!
struct:module-use*
'module-use*
2
0
struct:module-use
null
(current-inspector)
#f
'()
#f
'module-use*))
(define module-use*1.1
(|#%name|
module-use*
(record-constructor
(make-record-constructor-descriptor struct:module-use* #f #f))))
(define module-use*?_2564
(|#%name| module-use*? (record-predicate struct:module-use*)))
(define module-use*?
(|#%name|
module-use*?
(lambda (v)
(if (module-use*?_2564 v)
#t
($value
(if (impersonator? v) (module-use*?_2564 (impersonator-val v)) #f))))))
(define module-use*-extra-inspectorss_2584
(|#%name|
module-use*-extra-inspectorss
(record-accessor struct:module-use* 0)))
(define module-use*-extra-inspectorss
(|#%name|
module-use*-extra-inspectorss
(lambda (s)
(if (module-use*?_2564 s)
(module-use*-extra-inspectorss_2584 s)
($value
(impersonate-ref
module-use*-extra-inspectorss_2584
struct:module-use*
0
s
'module-use*
'extra-inspectorss))))))
(define module-use*-self-inspector_2469
(|#%name| module-use*-self-inspector (record-accessor struct:module-use* 1)))
(define module-use*-self-inspector
(|#%name|
module-use*-self-inspector
(lambda (s)
(if (module-use*?_2564 s)
(module-use*-self-inspector_2469 s)
($value
(impersonate-ref
module-use*-self-inspector_2469
struct:module-use*
1
s
'module-use*
'self-inspector))))))
(define set-module-use*-extra-inspectorss!_2709
(|#%name|
set-module-use*-extra-inspectorss!
(record-mutator struct:module-use* 0)))
(define set-module-use*-extra-inspectorss!
(|#%name|
set-module-use*-extra-inspectorss!
(lambda (s v)
(if (module-use*?_2564 s)
(set-module-use*-extra-inspectorss!_2709 s v)
($value
(impersonate-set!
set-module-use*-extra-inspectorss!_2709
struct:module-use*
0
2
s
v
'module-use*
'extra-inspectorss))))))
(define set-module-use*-self-inspector!_2824
(|#%name|
set-module-use*-self-inspector!
(record-mutator struct:module-use* 1)))
(define set-module-use*-self-inspector!
(|#%name|
set-module-use*-self-inspector!
(lambda (s v)
(if (module-use*?_2564 s)
(set-module-use*-self-inspector!_2824 s v)
($value
(impersonate-set!
set-module-use*-self-inspector!_2824
struct:module-use*
1
3
s
v
'module-use*
'self-inspector))))))
(define module-uses-add-extra-inspectorsss
(lambda (mus_0 extra-inspectorsss_0)
(if extra-inspectorsss_0
(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? lst_1) #f)
(let ((mu_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(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))))))
fold-var_0))))))
(for-loop_0 null mus_0 extra-inspectorsss_0))))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(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))))
fold-var_0))))))
(for-loop_0 null mus_0)))))))
(define module-uses-strip-extra-inspectorsss
(lambda (mu*s_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(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))))
fold-var_0))))))
(for-loop_0 null mu*s_0))))))
(define module-uses-extract-extra-inspectorsss
(lambda (mu*s_0 linklet_0 check-inlined-reference?_0 skip-n_0)
(if (not check-inlined-reference?_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(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))))
fold-var_0))))))
(for-loop_0 null mu*s_0))))
(reverse$1
(let ((lst_0 (list-tail (linklet-import-variables linklet_0) skip-n_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1 lst_2)
(begin
(if (if (pair? lst_1) (pair? lst_2) #f)
(let ((mu*_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((imports_0 (unsafe-car lst_2)))
(let ((rest_1 (unsafe-cdr lst_2)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((extra-inspectorss_0
(module-use*-extra-inspectorss
mu*_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (extra-inspectorss_1
lst_3)
(begin
(if (pair? lst_3)
(let ((import_0
(unsafe-car
lst_3)))
(let ((rest_2
(unsafe-cdr
lst_3)))
(let ((extra-inspectorss_2
(let ((extra-inspectorss_2
(if (eq?
(hash-ref
extra-inspectorss_1
import_0
kw2162)
kw2162)
(hash-set
extra-inspectorss_1
import_0
(set
(module-use*-self-inspector
mu*_0)))
extra-inspectorss_1)))
(values
extra-inspectorss_2))))
(for-loop_1
extra-inspectorss_2
rest_2))))
extra-inspectorss_1))))))
(for-loop_1
extra-inspectorss_0
imports_0))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0 rest_1))))))
fold-var_0))))))
(for-loop_0 null mu*s_0 lst_0))))))))
(define module-use*-declaration-inspector!
(lambda (mu*_0 insp_0) (set-module-use*-self-inspector! mu*_0 insp_0)))
(define module-use+extra-inspectors
(lambda (mpi_0
phase_0
imports_0
inspector_0
extra-inspector_0
extra-inspectorss_0)
(let ((now-inspector_0 (current-code-inspector)))
(let ((add-insp?_0
(if inspector_0
(inspector-superior? inspector_0 now-inspector_0)
#f)))
(let ((add-extra-insp?_0
(if extra-inspector_0
(inspector-superior? extra-inspector_0 now-inspector_0)
#f)))
(let ((new-extra-inspectorss_0
(if (if add-insp?_0 add-insp?_0 add-extra-insp?_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0)
(begin
(if (pair? lst_0)
(let ((import_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
import_0
(let ((extra-inspectors_0
(if extra-inspectorss_0
(hash-ref
extra-inspectorss_0
import_0
#f)
#f)))
(lambda (guard-insp_0)
(let ((or-part_0
(if add-insp?_0
(inspector-superior?
inspector_0
guard-insp_0)
#f)))
(if or-part_0
or-part_0
(let ((or-part_1
(if add-extra-insp?_0
(inspector-superior?
extra-inspector_0
guard-insp_0)
#f)))
(if or-part_1
or-part_1
(extra-inspectors-allow?
extra-inspectors_0
guard-insp_0)))))))))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 imports_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (extra-inspectorss_1 lst_0)
(begin
(if (pair? lst_0)
(let ((import_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((extra-inspectorss_2
(let ((extra-inspectorss_2
(if (hash-ref
extra-inspectorss_1
import_0
#f)
extra-inspectorss_1
(hash-set
extra-inspectorss_1
import_0
#f))))
(values extra-inspectorss_2))))
(for-loop_0 extra-inspectorss_2 rest_0))))
extra-inspectorss_1))))))
(for-loop_0
(if extra-inspectorss_0 extra-inspectorss_0 (seteq))
imports_0))))))
(module-use*1.1 mpi_0 phase_0 new-extra-inspectorss_0 #f)))))))
(define module-use-merge-extra-inspectorss!
(lambda (existing-mu*_0 mu*_0)
(let ((existing-extra-inspectorss_0
(module-use*-extra-inspectorss existing-mu*_0)))
(let ((extra-inspectorss_0 (module-use*-extra-inspectorss mu*_0)))
(let ((new-extra-inspectorss_0
(if (not existing-extra-inspectorss_0)
extra-inspectorss_0
(if (not extra-inspectorss_0)
existing-extra-inspectorss_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (new-extra-inspectorss_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
extra-inspectorss_0
i_0))
(case-lambda
((sym_0 extra-inspectors_0)
(let ((new-extra-inspectorss_1
(let ((new-extra-inspectorss_1
(hash-set
new-extra-inspectorss_0
sym_0
(extra-inspectors-merge
extra-inspectors_0
(hash-ref
new-extra-inspectorss_0
sym_0
(seteq))))))
(values new-extra-inspectorss_1))))
(for-loop_0
new-extra-inspectorss_1
(hash-iterate-next
extra-inspectorss_0
i_0))))
(args
(raise-binding-result-arity-error 2 args))))
new-extra-inspectorss_0))))))
(for-loop_0
existing-extra-inspectorss_0
(hash-iterate-first extra-inspectorss_0))))))))
(set-module-use*-extra-inspectorss!
existing-mu*_0
new-extra-inspectorss_0))))))
(define struct:link-info
(make-record-type-descriptor*
'link-info
#f
(|#%nongenerative-uid| link-info)
#f
#f
4
0))
(define effect_2302
(struct-type-install-properties!
struct:link-info
'link-info
4
0
#f
null
(current-inspector)
#f
'(0 1 2 3)
#f
'link-info))
(define link-info1.1
(|#%name|
link-info
(record-constructor
(make-record-constructor-descriptor struct:link-info #f #f))))
(define link-info?_2751
(|#%name| link-info? (record-predicate struct:link-info)))
(define link-info?
(|#%name|
link-info?
(lambda (v)
(if (link-info?_2751 v)
#t
($value
(if (impersonator? v) (link-info?_2751 (impersonator-val v)) #f))))))
(define link-info-link-module-uses_2350
(|#%name| link-info-link-module-uses (record-accessor struct:link-info 0)))
(define link-info-link-module-uses
(|#%name|
link-info-link-module-uses
(lambda (s)
(if (link-info?_2751 s)
(link-info-link-module-uses_2350 s)
($value
(impersonate-ref
link-info-link-module-uses_2350
struct:link-info
0
s
'link-info
'link-module-uses))))))
(define link-info-imports_2277
(|#%name| link-info-imports (record-accessor struct:link-info 1)))
(define link-info-imports
(|#%name|
link-info-imports
(lambda (s)
(if (link-info?_2751 s)
(link-info-imports_2277 s)
($value
(impersonate-ref
link-info-imports_2277
struct:link-info
1
s
'link-info
'imports))))))
(define link-info-extra-inspectorsss_2727
(|#%name| link-info-extra-inspectorsss (record-accessor struct:link-info 2)))
(define link-info-extra-inspectorsss
(|#%name|
link-info-extra-inspectorsss
(lambda (s)
(if (link-info?_2751 s)
(link-info-extra-inspectorsss_2727 s)
($value
(impersonate-ref
link-info-extra-inspectorsss_2727
struct:link-info
2
s
'link-info
'extra-inspectorsss))))))
(define link-info-def-decls_3021
(|#%name| link-info-def-decls (record-accessor struct:link-info 3)))
(define link-info-def-decls
(|#%name|
link-info-def-decls
(lambda (s)
(if (link-info?_2751 s)
(link-info-def-decls_3021 s)
($value
(impersonate-ref
link-info-def-decls_3021
struct:link-info
3
s
'link-info
'def-decls))))))
(define compile-forms.1
(|#%name|
compile-forms
(lambda (body-import-instances3_0
body-imports2_0
body-suffix-forms4_0
compiled-expression-callback8_0
definition-callback9_0
encoded-root-expand-ctx-box6_0
force-phases5_0
get-module-linklet-info11_0
module-prompt?13_0
optimize-linklet?15_0
other-form-callback10_0
root-ctx-only-if-syntax?7_0
serializable?12_0
to-correlated-linklet?14_0
unsafe?-box16_0
bodys32_0
cctx33_0
mpis34_0)
(begin
(let ((get-module-linklet-info_0
(if (eq? get-module-linklet-info11_0 unsafe-undefined)
(|#%name|
get-module-linklet-info
(lambda (mod-name_0 p_0) (begin #f)))
get-module-linklet-info11_0)))
(let ((phase_0 (compile-context-phase cctx33_0)))
(let ((self_0 (compile-context-self cctx33_0)))
(let ((syntax-literals_0 (make-syntax-literals)))
(let ((phase-to-body_0 (make-hasheqv)))
(let ((add-body!_0
(|#%name|
add-body!
(lambda (phase_1 body_0)
(begin
(let ((xform_0 (lambda (l_0) (cons body_0 l_0))))
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
phase-to-body_0
phase_1
xform_0
null))))))))
(let ((phase-to-header_0 (make-hasheqv)))
(let ((find-or-create-header!_0
(|#%name|
find-or-create-header!
(lambda (phase_1)
(begin
(let ((or-part_0
(hash-ref
phase-to-header_0
phase_1
#f)))
(if or-part_0
or-part_0
(let ((header_0
(make-header
mpis34_0
syntax-literals_0)))
(begin
(hash-set!
phase-to-header_0
phase_1
header_0)
header_0)))))))))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((phase_1 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(begin
(find-or-create-header!_0 phase_1)
(add-body!_0 phase_1 '(void)))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 force-phases5_0)))
(let ((saw-define-syntaxes?_0 #f))
(begin
(if (compile-context-module-self cctx33_0)
(letrec*
((loop!_0
(|#%name|
loop!
(lambda (bodys_0 phase_1 header_0)
(begin
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(if (parsed-define-values?
body_0)
(begin
(let ((lst_1
(parsed-define-values-syms
body_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (lst_2)
(begin
(if (pair?
lst_2)
(let ((sym_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(begin
(let ((def-sym_0
(select-fresh
sym_0
header_0)))
(begin
(hash-set!
(header-binding-sym-to-define-sym
header_0)
sym_0
def-sym_0)
(set-header-binding-syms-in-order!
header_0
(cons
sym_0
(header-binding-syms-in-order
header_0)))
(begin-unsafe
(hash-set!
(header-define-and-import-syms
header_0)
def-sym_0
'defined))))
(for-loop_1
rest_1))))
(values)))))))
(for-loop_1
lst_1))))
(void))
(if (parsed-begin-for-syntax?
body_0)
(let ((app_0
(add1
phase_1)))
(loop!_0
(parsed-begin-for-syntax-body
body_0)
app_0
(find-or-create-header!_0
(add1
phase_1))))
(void)))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0 bodys_0)))
(void)))))))
(loop!_0
bodys32_0
phase_0
(find-or-create-header!_0 phase_0)))
(void))
(let ((as-required?_0
(|#%name|
as-required?
(lambda (header_0)
(begin
(lambda (sym_0)
(registered-as-required?
header_0
sym_0)))))))
(let ((last-i_0 (sub1 (length bodys32_0))))
(begin
(letrec*
((loop!_0
(|#%name|
loop!
(lambda (bodys_0 phase_1 header_0)
(begin
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0 pos_0)
(begin
(if (if (pair? lst_0)
#t
#f)
(let ((body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(if (parsed-define-values?
body_0)
(let ((ids_0
(parsed-define-values-ids
body_0)))
(let ((binding-syms_0
(parsed-define-values-syms
body_0)))
(let ((def-syms_0
(if (compile-context-module-self
cctx33_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?
lst_2)
#f)
(let ((binding-sym_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)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((app_0
(hash-ref
(header-binding-sym-to-define-sym
header_0)
binding-sym_0)))
(correlate-source-name
app_0
(syntax-e$1
id_0)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_1
fold-var_1
rest_1
rest_2))))))
fold-var_0))))))
(for-loop_1
null
binding-syms_0
ids_0))))
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((binding-sym_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((temp62_0
(compile-context-self
cctx33_0)))
(register-required-variable-use!.1
#t
header_0
temp62_0
phase_1
binding-sym_0
#f))
fold-var_0)))
(values
fold-var_1))))
(for-loop_1
fold-var_1
rest_1))))
fold-var_0))))))
(for-loop_1
null
binding-syms_0)))))))
(let ((rhs_0
(let ((app_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))))
(compile$2
(parsed-define-values-rhs
body_0)
app_0
(if (=
(length
ids_0)
1)
(car
ids_0)
#f)))))
(begin
(|#%app|
definition-callback9_0)
(let ((app_0
(length
def-syms_0)))
(|#%app|
compiled-expression-callback8_0
rhs_0
app_0
phase_1
(as-required?_0
header_0)))
(add-body!_0
phase_1
(propagate-inline-property
(correlate*
(parsed-s
body_0)
(list
'define-values
def-syms_0
rhs_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
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
(parsed-define-syntaxes-ids
body_0)))
(let ((binding-syms_0
(parsed-define-syntaxes-syms
body_0)))
(let ((next-header_0
(find-or-create-header!_0
(add1
phase_1))))
(let ((gen-syms_0
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((binding-sym_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((gen-sym_0
(select-fresh
binding-sym_0
next-header_0)))
(begin
(begin-unsafe
(hash-set!
(header-define-and-import-syms
next-header_0)
gen-sym_0
'defined))
gen-sym_0))
fold-var_0)))
(values
fold-var_1))))
(for-loop_1
fold-var_1
rest_1))))
fold-var_0))))))
(for-loop_1
null
binding-syms_0))))))
(let ((rhs_0
(compile$2
(parsed-define-syntaxes-rhs
body_0)
(if (compile-context?
cctx33_0)
(let ((phase71_0
(add1
phase_1)))
(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)
(begin
(let ((app_0
(length
gen-syms_0)))
(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?
lst_2)
#f)
(let ((binding-sym_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((gen-sym_0
(unsafe-car
lst_2)))
(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_0
(add1
phase_1)))
(add-body!_0
app_0
(let ((app_1
(list
(list
gen-syms_0
rhs_0))))
(list
'let-values
app_1
(list*
'begin
(qq-append
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)
(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
(add1
phase_1)))
(loop!_0
(parsed-begin-for-syntax-body
body_0)
app_0
(find-or-create-header!_0
(add1
phase_1))))
(if (let ((or-part_0
(|parsed-#%declare?|
body_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(parsed-module?
body_0)))
(if or-part_1
or-part_1
(parsed-require?
body_0)))))
(let ((e_0
(|#%app|
other-form-callback10_0
body_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)))))
(if e_0
(begin
(|#%app|
compiled-expression-callback8_0
e_0
#f
phase_1
(as-required?_0
header_0))
(add-body!_0
phase_1
e_0))
(void)))
(let ((e_0
(let ((app_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))))
(compile$2
body_0
app_0
#f
(=
pos_0
last-i_0)))))
(begin
(|#%app|
compiled-expression-callback8_0
e_0
#f
phase_1
(as-required?_0
header_0))
(add-body!_0
phase_1
e_0)))))))
(for-loop_0
rest_0
(+ pos_0 1)))))
(values)))))))
(for-loop_0 bodys_0 0)))
(void)))))))
(loop!_0
bodys32_0
phase_0
(find-or-create-header!_0 phase_0)))
(let ((encoded-root-expand-pos_0
(if encoded-root-expand-ctx-box6_0
(if (unbox
encoded-root-expand-ctx-box6_0)
(if (not
(if root-ctx-only-if-syntax?7_0
(if (not
saw-define-syntaxes?_0)
(begin-unsafe
(null?
(syntax-literals-stxes
syntax-literals_0)))
#f)
#f))
(add-syntax-literal!
syntax-literals_0
(unbox
encoded-root-expand-ctx-box6_0))
#f)
#f)
#f)))
(let ((phases-in-order_0
(let ((temp79_0
(hash-keys
phase-to-body_0)))
(sort.1 #f #f temp79_0 <))))
(let ((min-phase_0
(if (pair? phases-in-order_0)
(car phases-in-order_0)
phase_0)))
(let ((max-phase_0
(if (pair? phases-in-order_0)
(car
(reverse$1
phases-in-order_0))
phase_0)))
(let ((phase-to-link-info_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0)
(begin
(if (pair? lst_0)
(let ((phase_1
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((header_0
(hash-ref
phase-to-header_0
phase_1
#f)))
(call-with-values
(lambda ()
(generate-links+imports
header_0
phase_1
cctx33_0
optimize-linklet?15_0))
(case-lambda
((link-module-uses_0
imports_0
extra-inspectorsss_0
def-decls_0)
(values
phase_1
(link-info1.1
link-module-uses_0
imports_0
extra-inspectorsss_0
def-decls_0)))
(args
(raise-binding-result-arity-error
4
args))))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
rest_0))))
table_0))))))
(for-loop_0
hash2725
phases-in-order_0)))))
(let ((body-linklets+module-use*s_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0
lst_0)
(begin
(if (pair? lst_0)
(let ((phase_1
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((bodys_0
(hash-ref
phase-to-body_0
phase_1)))
(let ((li_0
(hash-ref
phase-to-link-info_0
phase_1)))
(let ((binding-sym-to-define-sym_0
(header-binding-sym-to-define-sym
(hash-ref
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)))))
(let ((body-linklet_0
(let ((app_0
(qq-append
body-imports2_0
(link-info-imports
li_0))))
(let ((app_1
(let ((app_1
(link-info-def-decls
li_0)))
(qq-append
app_1
(reverse$1
(let ((lst_1
(header-binding-syms-in-order
(hash-ref
phase-to-header_0
phase_1))))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_0
lst_2)
(begin
(if (pair?
lst_2)
(let ((binding-sym_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((def-sym_0
(hash-ref
binding-sym-to-define-sym_0
binding-sym_0)))
(if (eq?
def-sym_0
binding-sym_0)
def-sym_0
(list
def-sym_0
binding-sym_0)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_1
fold-var_1
rest_1))))
fold-var_0))))))
(for-loop_1
null
lst_1)))))))))
(list*
'linklet
app_0
app_1
(qq-append
(reverse$1
bodys_0)
body-suffix-forms4_0))))))
(call-with-values
(lambda ()
(if to-correlated-linklet?14_0
(values
(begin-unsafe
(correlated-linklet1.1
body-linklet_0
'module
#f))
module-use*s_0)
(let ((temp89_0
(if unsafe?-box16_0
(unbox
unsafe?-box16_0)
#f)))
(let ((temp91_0
(compile-context-namespace
cctx33_0)))
(let ((temp89_1
temp89_0))
(compile-module-linklet.1
body-import-instances3_0
body-imports2_0
unsafe-undefined
get-module-linklet-info_0
#f
module-prompt?13_0
module-use*s_0
temp91_0
optimize-linklet?15_0
serializable?12_0
temp89_1
body-linklet_0))))))
(case-lambda
((linklet_0
new-module-use*s_0)
(values
phase_1
(cons
linklet_0
new-module-use*s_0)))
(args
(raise-binding-result-arity-error
2
args))))))))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
rest_0))))
table_0))))))
(for-loop_0
hash2610
phases-in-order_0)))))
(let ((body-linklets_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
body-linklets+module-use*s_0
i_0))
(case-lambda
((phase_1
l+mu*s_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_1
(car
l+mu*s_0)))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
(hash-iterate-next
body-linklets+module-use*s_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2610
(hash-iterate-first
body-linklets+module-use*s_0))))))
(let ((phase-to-link-module-uses_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
body-linklets+module-use*s_0
i_0))
(case-lambda
((phase_1
l+mu*s_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_1
(module-uses-strip-extra-inspectorsss
(cdr
l+mu*s_0))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
(hash-iterate-next
body-linklets+module-use*s_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2610
(hash-iterate-first
body-linklets+module-use*s_0))))))
(let ((phase-to-link-module-uses-expr_0
(serialize-phase-to-link-module-uses
phase-to-link-module-uses_0
mpis34_0)))
(let ((phase-to-link-extra-inspectorsss_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
body-linklets+module-use*s_0
i_0))
(case-lambda
((phase_1
l+mu*s_0)
(let ((table_1
(let ((extra-inspectorsss_0
(let ((app_0
(cdr
l+mu*s_0)))
(let ((app_1
(car
l+mu*s_0)))
(let ((app_2
(if optimize-linklet?15_0
(not
to-correlated-linklet?14_0)
#f)))
(module-uses-extract-extra-inspectorsss
app_0
app_1
app_2
(length
body-imports2_0)))))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(if extra-inspectorsss_0
(let ((table_2
(call-with-values
(lambda ()
(values
phase_1
extra-inspectorsss_0))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))
table_1)))
table_2))))))
(for-loop_1
table_0))))))
(for-loop_0
table_1
(hash-iterate-next
body-linklets+module-use*s_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2725
(hash-iterate-first
body-linklets+module-use*s_0))))))
(values
body-linklets_0
min-phase_0
max-phase_0
phase-to-link-module-uses_0
phase-to-link-module-uses-expr_0
phase-to-link-extra-inspectorsss_0
syntax-literals_0
encoded-root-expand-pos_0)))))))))))))))))))))))))))))
(define compile-top-level-bind
(lambda (ids_0 binding-syms_0 cctx_0 trans-exprs_0)
(let ((phase_0 (compile-context-phase cctx_0)))
(let ((self_0 (compile-context-self cctx_0)))
(let ((header_0 (compile-context-header cctx_0)))
(let ((mpis_0 (header-module-path-indexes header_0)))
(let ((top-level-bind-scope_0
(let ((v_0
(namespace-get-root-expand-ctx
(compile-context-namespace cctx_0))))
(begin-unsafe
(root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner v_0))))))
(let ((self-expr_0 (add-module-path-index! mpis_0 self_0)))
(list*
'begin
(reverse$1
(let ((lst_0
(if trans-exprs_0
trans-exprs_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 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 ids_0)))))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1 lst_2 lst_3)
(begin
(if (if (pair? lst_1)
(if (pair? lst_2) (pair? lst_3) #f)
#f)
(let ((id_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((binding-sym_0 (unsafe-car lst_2)))
(let ((rest_1 (unsafe-cdr lst_2)))
(let ((trans-expr_0
(unsafe-car lst_3)))
(let ((rest_2 (unsafe-cdr lst_3)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((id-stx_0
(compile-quote-syntax
(remove-scope
id_0
top-level-bind-scope_0)
cctx_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
fold-var_1
rest_0
rest_1
rest_2))))))))
fold-var_0))))))
(for-loop_0
null
ids_0
binding-syms_0
lst_0))))))))))))))
(define generate-top-level-define-syntaxes
(lambda (gen-syms_0 rhs_0 transformer-set!s_0 finish_0)
(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
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
(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
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
(syntax-property$1 orig-s_0 'compiler-hint:cross-module-inline)))
(if v_0
(begin-unsafe
(syntax-property e_0 'compiler-hint:cross-module-inline v_0))
e_0))))
(define compile-module-linklet.1
(|#%name|
compile-module-linklet
(lambda (body-import-instances38_0
body-imports37_0
compile-linklet36_0
get-module-linklet-info39_0
load-modules?45_0
module-prompt?41_0
module-use*s42_0
namespace46_0
optimize-linklet?43_0
serializable?40_0
unsafe?44_0
body-linklet58_0)
(begin
(let ((compile-linklet_0
(if (eq? compile-linklet36_0 unsafe-undefined)
compile-linklet
compile-linklet36_0)))
(call-with-values
(lambda ()
(begin
(if log-performance?
(start-performance-region 'compile '_ 'linklet)
(void))
(begin0
(let ((keys_0
(list->vector
(append body-import-instances38_0 module-use*s42_0))))
(let ((getter_0
(make-module-use-to-linklet
optimize-linklet?43_0
load-modules?45_0
namespace46_0
get-module-linklet-info39_0
module-use*s42_0)))
(let ((keys_1 keys_0))
(|#%app|
compile-linklet_0
body-linklet58_0
'module
keys_1
getter_0
(let ((flags_0
(if serializable?40_0
(if module-prompt?41_0
'(serializable use-prompt)
'(serializable))
(if module-prompt?41_0
'(use-prompt)
(if optimize-linklet?43_0 '() '(quick))))))
(if unsafe?44_0 (cons 'unsafe flags_0) flags_0))))))
(if log-performance? (end-performance-region) (void)))))
(case-lambda
((linklet_0 new-module-use*s_0)
(values
linklet_0
(let ((app_0 (vector->list new-module-use*s_0)))
(list-tail app_0 (length body-imports37_0)))))
(args (raise-binding-result-arity-error 2 args)))))))))
(define make-module-use-to-linklet
(lambda (optimize-linklet?_0
load-modules?_0
ns_0
get-module-linklet-info_0
init-mu*s_0)
(let ((mu*-intern-table_0 (make-hash)))
(let ((intern-module-use*_0
(|#%name|
intern-module-use*
(lambda (mu*_0)
(begin
(let ((mod-name_0
(1/module-path-index-resolve
(module-use-module mu*_0))))
(let ((existing-mu*_0
(hash-ref
mu*-intern-table_0
(cons mod-name_0 (module-use-phase mu*_0))
#f)))
(if existing-mu*_0
(begin
(module-use-merge-extra-inspectorss!
existing-mu*_0
mu*_0)
existing-mu*_0)
(begin
(hash-set!
mu*-intern-table_0
(cons mod-name_0 (module-use-phase mu*_0))
mu*_0)
mu*_0)))))))))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((mu*_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(intern-module-use*_0 mu*_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 init-mu*s_0)))
(void)
(lambda (mu*-or-instance_0)
(if (instance? mu*-or-instance_0)
(values mu*-or-instance_0 #f)
(if (not optimize-linklet?_0)
(values #f #f)
(if mu*-or-instance_0
(let ((mod-name_0
(1/module-path-index-resolve
(module-use-module mu*-or-instance_0)
load-modules?_0)))
(let ((mli_0
(let ((or-part_0
(|#%app|
get-module-linklet-info_0
mod-name_0
(module-use-phase mu*-or-instance_0))))
(if or-part_0
or-part_0
(namespace->module-linklet-info
ns_0
mod-name_0
(module-use-phase mu*-or-instance_0))))))
(begin
(if mli_0
(let ((insp_0 (module-linklet-info-inspector mli_0)))
(begin-unsafe
(set-module-use*-self-inspector!
mu*-or-instance_0
insp_0)))
(void))
(if mli_0
(values
(module-linklet-info-linklet-or-instance mli_0)
(if (module-linklet-info-module-uses mli_0)
(list->vector
(append
'(#f #f)
(let ((mus_0
(module-linklet-info-module-uses mli_0)))
(let ((extra-inspectorsss_0
(module-linklet-info-extra-inspectorsss
mli_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_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)
#f)
(let ((sub-mu_0
(unsafe-car
lst_3)))
(let ((rest_0
(unsafe-cdr
lst_3)))
(let ((imports_0
(unsafe-car
lst_4)))
(let ((rest_1
(unsafe-cdr
lst_4)))
(let ((extra-inspectorss_0
(unsafe-car
lst_5)))
(let ((rest_2
(unsafe-cdr
lst_5)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(intern-module-use*_0
(let ((app_0
(let ((app_0
(module-use-module
sub-mu_0)))
(module-path-index-shift
app_0
(module-linklet-info-self
mli_0)
(module-use-module
mu*-or-instance_0)))))
(let ((app_1
(module-use-phase
sub-mu_0)))
(module-use+extra-inspectors
app_0
app_1
imports_0
(module-linklet-info-inspector
mli_0)
(module-linklet-info-extra-inspector
mli_0)
(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))))))))))
(define build-shared-data-linklet.1
(|#%name|
build-shared-data-linklet
(lambda (to-correlated-linklet?1_0 cims3_0 ns4_0)
(begin
(let ((mpis_0 (make-module-path-index-table)))
(let ((mpi-trees_0
(map-cim-tree
cims3_0
(lambda (cim_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((vec_0 (compiled-in-memory-mpis cim_0)))
(begin
(check-vector vec_0)
(values vec_0 (unsafe-vector-length vec_0)))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (vec_1 i_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((mpi_0
(unsafe-vector-ref vec_0 pos_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((new-vec_0
(if (eq?
i_0
(unsafe-vector*-length
vec_1))
(grow-vector vec_1)
vec_1)))
(begin
(unsafe-vector*-set!
new-vec_0
i_0
(add-module-path-index!/pos
mpis_0
mpi_0))
(values
new-vec_0
(unsafe-fx+ i_0 1)))))
(case-lambda
((vec_2 i_1) (values vec_2 i_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((vec_2 i_1)
(for-loop_0
vec_2
i_1
(unsafe-fx+ 1 pos_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(values vec_1 i_0)))))))
(for-loop_0 (make-vector 16) 0 0))))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((vec_0 i_0) (shrink-vector vec_0 i_0))
(args (raise-binding-result-arity-error 2 args))))))))
(let ((syntax-literals_0 (make-syntax-literals)))
(let ((syntax-literals-trees_0
(map-cim-tree
cims3_0
(lambda (cim_0)
(add-syntax-literals!
syntax-literals_0
(compiled-in-memory-syntax-literals cim_0))))))
(let ((module-uses-tables_0 null))
(let ((module-uses-tables-count_0 0))
(let ((phase-to-link-module-uses-trees_0
(map-cim-tree
cims3_0
(lambda (cim_0)
(let ((pos_0 module-uses-tables-count_0))
(begin
(set! module-uses-tables_0
(let ((app_0
(compiled-in-memory-phase-to-link-module-uses
cim_0)))
(cons app_0 module-uses-tables_0)))
(set! module-uses-tables-count_0 (add1 pos_0))
pos_0))))))
(let ((syntax-literals-expr_0
(generate-eager-syntax-literals!
syntax-literals_0
mpis_0
0
#f
ns4_0)))
(let ((phase-to-link-module-uses-expr_0
(list*
'vector
(reverse$1
(let ((lst_0 (reverse$1 module-uses-tables_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((phase-to-link-module-uses_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(serialize-phase-to-link-module-uses
phase-to-link-module-uses_0
mpis_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0))))))))
(let ((app_0
(list
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*
((loop_0
(|#%name|
loop
(lambda (cims_1)
(begin
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((cim_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((app_0
(|#%app| proc_0 cim_0)))
(let ((app_1
(loop_0
(compiled-in-memory-pre-compiled-in-memorys
cim_0))))
(vector
app_0
app_1
(loop_0
(compiled-in-memory-post-compiled-in-memorys
cim_0)))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null cims_1)))))))))
(loop_0 cims_0))))
(define compiled-tops->compiled-top.1
(|#%name|
compiled-tops->compiled-top
(lambda (merge-serialization?2_0
namespace3_0
to-correlated-linklet?1_0
all-cims7_0)
(begin
(let ((cims_0 (remove-nontail-purely-functional all-cims7_0)))
(if (= 1 (length cims_0))
(car cims_0)
(let ((sequence-ht_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((cim_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((app_0
(string->symbol
(number->string
pos_0))))
(values
app_0
(compiled-in-memory-linklet-directory
cim_0))))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0 (+ pos_0 1)))))
table_0))))))
(for-loop_0 hash2610 cims_0 0)))))
(let ((ht_0
(if merge-serialization?2_0
(hash-set
sequence-ht_0
'data
(hash->linklet-directory
(hasheq
#f
(hash->linklet-bundle
(hasheq
0
(build-shared-data-linklet.1
to-correlated-linklet?1_0
cims_0
namespace3_0))))))
sequence-ht_0)))
(compiled-in-memory1.1
(hash->linklet-directory ht_0)
#f
#f
#f
hash2589
#f
hash2589
'#()
'#()
cims_0
null
#f
#f)))))))))
(define compiled-top->compiled-tops
(lambda (ld_0)
(let ((ht_0 (linklet-directory->hash$1 ld_0)))
(reverse$1
(let ((end_0 (hash-count ht_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((fold-var_1
(let ((top_0
(hash-ref
ht_0
(string->symbol (number->string pos_0))
#f)))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1)
(begin
(let ((fold-var_2
(if top_0
(let ((fold-var_2
(cons
top_0
fold-var_1)))
(values fold-var_2))
fold-var_1)))
fold-var_2))))))
(for-loop_1 fold-var_0))))))
(for-loop_0 fold-var_1 (+ pos_0 1)))
fold-var_0))))))
(for-loop_0 null 0))))))))
(define remove-nontail-purely-functional
(lambda (cims_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (cims_1)
(begin
(if (null? cims_1)
null
(if (null? (cdr cims_1))
cims_1
(if (if (compiled-in-memory? (car cims_1))
(compiled-in-memory-purely-functional? (car cims_1))
#f)
(loop_0 (cdr cims_1))
(let ((app_0 (car cims_1)))
(cons app_0 (cdr cims_1)))))))))))
(loop_0 cims_0))))
(define struct:known-defined/delay
(make-record-type-descriptor*
'known-defined/delay
#f
(structure-type-lookup-prefab-uid 'known-defined/delay #f 1 0 #f '(0))
#f
#f
1
1))
(define effect_2936
(struct-type-install-properties!
struct:known-defined/delay
'known-defined/delay
1
0
#f
null
'prefab
#f
'(0)
#f
'known-defined/delay))
(define known-defined/delay2.1
(|#%name|
known-defined/delay
(record-constructor
(make-record-constructor-descriptor struct:known-defined/delay #f #f))))
(define known-defined/delay?_2399
(|#%name|
known-defined/delay?
(record-predicate struct:known-defined/delay)))
(define known-defined/delay?
(|#%name|
known-defined/delay?
(lambda (v)
(if (known-defined/delay?_2399 v)
#t
($value
(if (impersonator? v)
(known-defined/delay?_2399 (impersonator-val v))
#f))))))
(define known-defined/delay-thunk_1981
(|#%name|
known-defined/delay-thunk
(record-accessor struct:known-defined/delay 0)))
(define known-defined/delay-thunk
(|#%name|
known-defined/delay-thunk
(lambda (s)
(if (known-defined/delay?_2399 s)
(known-defined/delay-thunk_1981 s)
($value
(impersonate-ref
known-defined/delay-thunk_1981
struct:known-defined/delay
0
s
'known-defined/delay
'thunk))))))
(define struct:known-property
(make-record-type-descriptor*
'known-property
#f
(structure-type-lookup-prefab-uid 'known-property #f 0 0 #f '())
#f
#f
0
0))
(define effect_2983
(struct-type-install-properties!
struct:known-property
'known-property
0
0
#f
null
'prefab
#f
'()
#f
'known-property))
(define known-property3.1
(|#%name|
known-property
(record-constructor
(make-record-constructor-descriptor struct:known-property #f #f))))
(define known-property?_2907
(|#%name| known-property? (record-predicate struct:known-property)))
(define known-property?
(|#%name|
known-property?
(lambda (v)
(if (known-property?_2907 v)
#t
($value
(if (impersonator? v)
(known-property?_2907 (impersonator-val v))
#f))))))
(define struct:known-property-of-function
(make-record-type-descriptor*
'known-property-of-function
#f
(structure-type-lookup-prefab-uid
'known-property-of-function
#f
1
0
#f
'(0))
#f
#f
1
1))
(define effect_2487
(struct-type-install-properties!
struct:known-property-of-function
'known-property-of-function
1
0
#f
null
'prefab
#f
'(0)
#f
'known-property-of-function))
(define known-property-of-function4.1
(|#%name|
known-property-of-function
(record-constructor
(make-record-constructor-descriptor
struct:known-property-of-function
#f
#f))))
(define known-property-of-function?_3246
(|#%name|
known-property-of-function?
(record-predicate struct:known-property-of-function)))
(define known-property-of-function?
(|#%name|
known-property-of-function?
(lambda (v)
(if (known-property-of-function?_3246 v)
#t
($value
(if (impersonator? v)
(known-property-of-function?_3246 (impersonator-val v))
#f))))))
(define known-property-of-function-arity_2841
(|#%name|
known-property-of-function-arity
(record-accessor struct:known-property-of-function 0)))
(define known-property-of-function-arity
(|#%name|
known-property-of-function-arity
(lambda (s)
(if (known-property-of-function?_3246 s)
(known-property-of-function-arity_2841 s)
($value
(impersonate-ref
known-property-of-function-arity_2841
struct:known-property-of-function
0
s
'known-property-of-function
'arity))))))
(define struct:known-function
(make-record-type-descriptor*
'known-function
#f
(structure-type-lookup-prefab-uid 'known-function #f 2 0 #f '(0 1))
#f
#f
2
3))
(define effect_2284
(struct-type-install-properties!
struct:known-function
'known-function
2
0
#f
null
'prefab
#f
'(0 1)
#f
'known-function))
(define known-function5.1
(|#%name|
known-function
(record-constructor
(make-record-constructor-descriptor struct:known-function #f #f))))
(define known-function?_2201
(|#%name| known-function? (record-predicate struct:known-function)))
(define known-function?
(|#%name|
known-function?
(lambda (v)
(if (known-function?_2201 v)
#t
($value
(if (impersonator? v)
(known-function?_2201 (impersonator-val v))
#f))))))
(define known-function-arity_3107
(|#%name| known-function-arity (record-accessor struct:known-function 0)))
(define known-function-arity
(|#%name|
known-function-arity
(lambda (s)
(if (known-function?_2201 s)
(known-function-arity_3107 s)
($value
(impersonate-ref
known-function-arity_3107
struct:known-function
0
s
'known-function
'arity))))))
(define known-function-pure?_2002
(|#%name| known-function-pure? (record-accessor struct:known-function 1)))
(define known-function-pure?
(|#%name|
known-function-pure?
(lambda (s)
(if (known-function?_2201 s)
(known-function-pure?_2002 s)
($value
(impersonate-ref
known-function-pure?_2002
struct:known-function
1
s
'known-function
'pure?))))))
(define struct:known-function-of-satisfying
(make-record-type-descriptor*
'known-function-of-satisfying
#f
(structure-type-lookup-prefab-uid
'known-function-of-satisfying
#f
1
0
#f
'(0))
#f
#f
1
1))
(define effect_2673
(struct-type-install-properties!
struct:known-function-of-satisfying
'known-function-of-satisfying
1
0
#f
null
'prefab
#f
'(0)
#f
'known-function-of-satisfying))
(define known-function-of-satisfying6.1
(|#%name|
known-function-of-satisfying
(record-constructor
(make-record-constructor-descriptor
struct:known-function-of-satisfying
#f
#f))))
(define known-function-of-satisfying?_2900
(|#%name|
known-function-of-satisfying?
(record-predicate struct:known-function-of-satisfying)))
(define known-function-of-satisfying?
(|#%name|
known-function-of-satisfying?
(lambda (v)
(if (known-function-of-satisfying?_2900 v)
#t
($value
(if (impersonator? v)
(known-function-of-satisfying?_2900 (impersonator-val v))
#f))))))
(define known-function-of-satisfying-arg-predicate-keys_2999
(|#%name|
known-function-of-satisfying-arg-predicate-keys
(record-accessor struct:known-function-of-satisfying 0)))
(define known-function-of-satisfying-arg-predicate-keys
(|#%name|
known-function-of-satisfying-arg-predicate-keys
(lambda (s)
(if (known-function-of-satisfying?_2900 s)
(known-function-of-satisfying-arg-predicate-keys_2999 s)
($value
(impersonate-ref
known-function-of-satisfying-arg-predicate-keys_2999
struct:known-function-of-satisfying
0
s
'known-function-of-satisfying
'arg-predicate-keys))))))
(define struct:known-predicate
(make-record-type-descriptor*
'known-predicate
#f
(structure-type-lookup-prefab-uid 'known-predicate #f 1 0 #f '(0))
#f
#f
1
1))
(define effect_2149
(struct-type-install-properties!
struct:known-predicate
'known-predicate
1
0
#f
null
'prefab
#f
'(0)
#f
'known-predicate))
(define known-predicate7.1
(|#%name|
known-predicate
(record-constructor
(make-record-constructor-descriptor struct:known-predicate #f #f))))
(define known-predicate?_2903
(|#%name| known-predicate? (record-predicate struct:known-predicate)))
(define known-predicate?
(|#%name|
known-predicate?
(lambda (v)
(if (known-predicate?_2903 v)
#t
($value
(if (impersonator? v)
(known-predicate?_2903 (impersonator-val v))
#f))))))
(define known-predicate-key_2853
(|#%name| known-predicate-key (record-accessor struct:known-predicate 0)))
(define known-predicate-key
(|#%name|
known-predicate-key
(lambda (s)
(if (known-predicate?_2903 s)
(known-predicate-key_2853 s)
($value
(impersonate-ref
known-predicate-key_2853
struct:known-predicate
0
s
'known-predicate
'key))))))
(define struct:known-satisfies
(make-record-type-descriptor*
'known-satisfies
#f
(structure-type-lookup-prefab-uid 'known-satisfies #f 1 0 #f '(0))
#f
#f
1
1))
(define effect_2870
(struct-type-install-properties!
struct:known-satisfies
'known-satisfies
1
0
#f
null
'prefab
#f
'(0)
#f
'known-satisfies))
(define known-satisfies8.1
(|#%name|
known-satisfies
(record-constructor
(make-record-constructor-descriptor struct:known-satisfies #f #f))))
(define known-satisfies?_2354
(|#%name| known-satisfies? (record-predicate struct:known-satisfies)))
(define known-satisfies?
(|#%name|
known-satisfies?
(lambda (v)
(if (known-satisfies?_2354 v)
#t
($value
(if (impersonator? v)
(known-satisfies?_2354 (impersonator-val v))
#f))))))
(define known-satisfies-predicate-key_2990
(|#%name|
known-satisfies-predicate-key
(record-accessor struct:known-satisfies 0)))
(define known-satisfies-predicate-key
(|#%name|
known-satisfies-predicate-key
(lambda (s)
(if (known-satisfies?_2354 s)
(known-satisfies-predicate-key_2990 s)
($value
(impersonate-ref
known-satisfies-predicate-key_2990
struct:known-satisfies
0
s
'known-satisfies
'predicate-key))))))
(define struct:known-struct-op
(make-record-type-descriptor*
'known-struct-op
#f
(structure-type-lookup-prefab-uid 'known-struct-op #f 2 0 #f '(0 1))
#f
#f
2
3))
(define effect_3126
(struct-type-install-properties!
struct:known-struct-op
'known-struct-op
2
0
#f
null
'prefab
#f
'(0 1)
#f
'known-struct-op))
(define known-struct-op9.1
(|#%name|
known-struct-op
(record-constructor
(make-record-constructor-descriptor struct:known-struct-op #f #f))))
(define known-struct-op?_2475
(|#%name| known-struct-op? (record-predicate struct:known-struct-op)))
(define known-struct-op?
(|#%name|
known-struct-op?
(lambda (v)
(if (known-struct-op?_2475 v)
#t
($value
(if (impersonator? v)
(known-struct-op?_2475 (impersonator-val v))
#f))))))
(define known-struct-op-type_2095
(|#%name| known-struct-op-type (record-accessor struct:known-struct-op 0)))
(define known-struct-op-type
(|#%name|
known-struct-op-type
(lambda (s)
(if (known-struct-op?_2475 s)
(known-struct-op-type_2095 s)
($value
(impersonate-ref
known-struct-op-type_2095
struct:known-struct-op
0
s
'known-struct-op
'type))))))
(define known-struct-op-field-count_2507
(|#%name|
known-struct-op-field-count
(record-accessor struct:known-struct-op 1)))
(define known-struct-op-field-count
(|#%name|
known-struct-op-field-count
(lambda (s)
(if (known-struct-op?_2475 s)
(known-struct-op-field-count_2507 s)
($value
(impersonate-ref
known-struct-op-field-count_2507
struct:known-struct-op
1
s
'known-struct-op
'field-count))))))
(define lookup-defn
(lambda (defns_0 sym_0)
(let ((d_0 (hash-ref defns_0 sym_0 #f)))
(if (known-defined/delay? d_0)
(begin
(|#%app| (known-defined/delay-thunk d_0))
(lookup-defn defns_0 sym_0))
d_0))))
(define any-side-effects?.1
(|#%name|
any-side-effects?
(lambda (known-defns2_0
known-locals1_0
ready-variable?3_0
e7_0
expected-results8_0)
(begin
(let ((ready-variable?_0
(if (eq? ready-variable?3_0 unsafe-undefined)
(|#%name| ready-variable? (lambda (id_0) (begin #f)))
ready-variable?3_0)))
(let ((effects?_0
(|#%name|
effects?
(lambda (e_0 expected-results_0 locals_0)
(begin
(any-side-effects?.1
known-defns2_0
locals_0
ready-variable?_0
e_0
expected-results_0))))))
(let ((actual-results_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (e_0 locals_0)
(begin
(let ((tmp_0
(if (pair? (correlated-e e_0))
(correlated-e (car (correlated-e e_0)))
#f)))
(let ((index_0
(if (symbol? tmp_0)
(hash-ref hash2430 tmp_0 (lambda () 0))
0)))
(if (unsafe-fx< index_0 6)
(if (unsafe-fx< index_0 2)
(if (unsafe-fx< index_0 1)
(let ((v_0 (correlated-e e_0)))
(if (let ((or-part_0 (string? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (number? v_0)))
(if or-part_1
or-part_1
(let ((or-part_2
(boolean? v_0)))
(if or-part_2
or-part_2
(char? v_0)))))))
1
(let ((c1_0
(if (pair? v_0)
(let ((rator_0
(correlated-e
(car v_0))))
(let ((or-part_0
(hash-ref
locals_0
rator_0
#f)))
(if or-part_0
or-part_0
(lookup-defn
known-defns2_0
rator_0))))
#f)))
(if c1_0
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(let ((_0
(let ((s_1
(car s_0)))
s_1)))
(let ((e18_0
(let ((s_1
(cdr
s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(let ((flat-s_0
(to-syntax-list.1$1
s_2)))
(if (not
flat-s_0)
(let ((str_0
"bad syntax"))
(error
str_0))
flat-s_0))))))
(let ((_1 _0))
(values
_1
e18_0))))
(let ((str_0
"bad syntax"))
(error str_0)))))
(case-lambda
((_0 e16_0)
(values #t _0 e16_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 _0 e16_0)
(let ((n-args_0 (length e16_0)))
(if (let ((or-part_0
(if (let ((or-part_0
(if (known-struct-op?
c1_0)
(if (eq?
'constructor
(known-struct-op-type
c1_0))
(=
(known-struct-op-field-count
c1_0)
n-args_0)
#f)
#f)))
(if or-part_0
or-part_0
(if (known-function?
c1_0)
(if (known-function-pure?
c1_0)
(arity-includes?
(known-function-arity
c1_0)
n-args_0)
#f)
#f)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((e_1
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((result_1
(let ((result_1
(not
(effects?_0
e_1
1
locals_0))))
(values
result_1))))
(if (if (not
(let ((x_0
(list
e_1)))
(not
result_1)))
#t
#f)
(for-loop_0
result_1
rest_0)
result_1))))
result_0))))))
(for-loop_0
#t
e16_0)))
#f)))
(if or-part_0
or-part_0
(if (known-function-of-satisfying?
c1_0)
(if (=
n-args_0
(length
(known-function-of-satisfying-arg-predicate-keys
c1_0)))
(let ((lst_0
(known-function-of-satisfying-arg-predicate-keys
c1_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0
lst_1
lst_2)
(begin
(if (if (pair?
lst_1)
(pair?
lst_2)
#f)
(let ((e_1
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((key_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((result_1
(let ((result_1
(if (not
(effects?_0
e_1
1
locals_0))
(satisfies?
e_1
key_0
known-defns2_0
locals_0)
#f)))
(values
result_1))))
(if (if (not
(let ((x_0
(list
e_1)))
(not
result_1)))
(if (not
(let ((x_0
(list
key_0)))
(not
result_1)))
#t
#f)
#f)
(for-loop_0
result_1
rest_0
rest_1)
result_1))))))
result_0))))))
(for-loop_0
#t
e16_0
lst_0))))
#f)
#f)))
1
#f)))
(args
(raise-binding-result-arity-error
3
args))))
(if (let ((or-part_0
(self-quoting-in-linklet?
v_0)))
(if or-part_0
or-part_0
(if (symbol? v_0)
(let ((or-part_1
(hash-ref
locals_0
v_0
#f)))
(if or-part_1
or-part_1
(let ((or-part_2
(lookup-defn
known-defns2_0
v_0)))
(if or-part_2
or-part_2
(let ((or-part_3
(begin-unsafe
(hash-ref
built-in-symbols
v_0
#f))))
(if or-part_3
or-part_3
(|#%app|
ready-variable?_0
v_0)))))))
#f)))
1
#f)))))
1)
(if (unsafe-fx< index_0 3)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(let ((_0
(let ((s_1 (car s_0)))
s_1)))
(call-with-values
(lambda ()
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax? s_1)
(syntax-e s_1)
s_1)))
(if (pair? s_2)
(call-with-values
(lambda ()
(let ((s_3
(car s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((flat-s_0
(to-syntax-list.1$1
s_4)))
(if (not
flat-s_0)
(let ((str_0
"bad syntax"))
(error
str_0))
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ids_0
rhs_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((s_5
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (pair?
s_6)
(let ((ids30_0
(let ((s_7
(car
s_6)))
s_7)))
(let ((rhs31_0
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(if (pair?
s_8)
(let ((rhs32_0
(let ((s_9
(car
s_8)))
s_9)))
(call-with-values
(lambda ()
(let ((s_9
(cdr
s_8)))
(let ((s_10
(if (syntax?
s_9)
(syntax-e
s_9)
s_9)))
(if (null?
s_10)
(values)
(let ((str_0
"bad syntax"))
(error
str_0))))))
(case-lambda
(()
(let ((rhs32_1
rhs32_0))
(values
rhs32_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(let ((str_0
"bad syntax"))
(error
str_0)))))))
(let ((ids30_1
ids30_0))
(values
ids30_1
rhs31_0))))
(let ((str_0
"bad syntax"))
(error
str_0)))))
(case-lambda
((ids34_0
rhs35_0)
(values
(cons
ids34_0
ids_0)
(cons
rhs35_0
rhs_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ids_1
rhs_1)
(values
ids_1
rhs_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ids_1
rhs_1)
(for-loop_0
ids_1
rhs_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
ids_0
rhs_0)))))))
(for-loop_0
null
null
flat-s_0))))
(case-lambda
((ids_0
rhs_0)
(let ((app_0
(reverse$1
ids_0)))
(values
app_0
(reverse$1
rhs_0))))
(args
(raise-binding-result-arity-error
2
args)))))))))
(case-lambda
((ids27_0 rhs28_0)
(let ((body29_0
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(if (pair?
s_4)
(let ((body33_0
(let ((s_5
(car
s_4)))
s_5)))
(call-with-values
(lambda ()
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (null?
s_6)
(values)
(let ((str_0
"bad syntax"))
(error
str_0))))))
(case-lambda
(()
(let ((body33_1
body33_0))
(values
body33_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(let ((str_0
"bad syntax"))
(error
str_0)))))))
(let ((ids27_1
ids27_0)
(rhs28_1
rhs28_0))
(values
ids27_1
rhs28_1
body29_0))))
(args
(raise-binding-result-arity-error
2
args))))
(let ((str_0
"bad syntax"))
(error str_0))))))
(case-lambda
((ids24_0 rhs25_0 body26_0)
(let ((_1 _0))
(values
_1
ids24_0
rhs25_0
body26_0)))
(args
(raise-binding-result-arity-error
3
args)))))
(let ((str_0 "bad syntax"))
(error str_0)))))
(case-lambda
((_0 ids20_0 rhs21_0 body22_0)
(values
#t
_0
ids20_0
rhs21_0
body22_0))
(args
(raise-binding-result-arity-error
4
args)))))
(case-lambda
((ok?_0 _0 ids20_0 rhs21_0 body22_0)
(if (not
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0
lst_0
lst_1)
(begin
(if (if (pair? lst_0)
(pair? lst_1)
#f)
(let ((ids_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((rhs_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((result_1
(let ((result_1
(effects?_0
rhs_0
(correlated-length
ids_0)
locals_0)))
(values
result_1))))
(if (if (not
(let ((x_0
(list
ids_0)))
result_1))
(if (not
(let ((x_0
(list
rhs_0)))
result_1))
#t
#f)
#f)
(for-loop_0
result_1
rest_0
rest_1)
result_1))))))
result_0))))))
(for-loop_0
#f
ids20_0
rhs21_0))))
(loop_0
body22_0
(add-binding-info
locals_0
ids20_0
rhs21_0))
#f))
(args
(raise-binding-result-arity-error
5
args))))
(if (unsafe-fx< index_0 4)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(let ((_0
(let ((s_1 (car s_0)))
s_1)))
(let ((e39_0
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(let ((flat-s_0
(to-syntax-list.1$1
s_2)))
(if (not
flat-s_0)
(let ((str_0
"bad syntax"))
(error
str_0))
flat-s_0))))))
(let ((_1 _0))
(values _1 e39_0))))
(let ((str_0 "bad syntax"))
(error str_0)))))
(case-lambda
((_0 e37_0) (values #t _0 e37_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 _0 e37_0)
(if (begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_1
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((result_1
(let ((result_1
(not
(effects?_0
e_1
1
locals_0))))
(values
result_1))))
(if (if (not
(let ((x_0
(list
e_1)))
(not
result_1)))
#t
#f)
(for-loop_0
result_1
rest_0)
result_1))))
result_0))))))
(for-loop_0 #t e37_0)))
(length e37_0)
#f))
(args
(raise-binding-result-arity-error
3
args))))
(if (unsafe-fx< index_0 5)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(let ((_0
(let ((s_1 (car s_0)))
s_1)))
(let ((e43_0
(let ((s_1
(cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(let ((flat-s_0
(to-syntax-list.1$1
s_2)))
(if (not
flat-s_0)
(let ((str_0
"bad syntax"))
(error
str_0))
flat-s_0))))))
(let ((_1 _0))
(values _1 e43_0))))
(let ((str_0 "bad syntax"))
(error str_0)))))
(case-lambda
((_0 e41_0) (values #t _0 e41_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 _0 e41_0)
(if (begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_1
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((result_1
(let ((result_1
(not
(effects?_0
e_1
1
locals_0))))
(values
result_1))))
(if (if (not
(let ((x_0
(list
e_1)))
(not
result_1)))
#t
#f)
(for-loop_0
result_1
rest_0)
result_1))))
result_0))))))
(for-loop_0 #t e41_0)))
1
#f))
(args
(raise-binding-result-arity-error
3
args))))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(let ((_0
(let ((s_1 (car s_0)))
s_1)))
(let ((e47_0
(let ((s_1
(cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(let ((flat-s_0
(to-syntax-list.1$1
s_2)))
(if (not
flat-s_0)
(let ((str_0
"bad syntax"))
(error
str_0))
flat-s_0))))))
(let ((_1 _0))
(values _1 e47_0))))
(let ((str_0 "bad syntax"))
(error str_0)))))
(case-lambda
((_0 e45_0) (values #t _0 e45_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 _0 e45_0)
(letrec*
((bloop_0
(|#%name|
bloop
(lambda (es_0)
(begin
(if (null? es_0)
#f
(if (null? (cdr es_0))
(loop_0
(car es_0)
locals_0)
(if (not
(effects?_0
(car es_0)
#f
locals_0))
(bloop_0 (cdr es_0))
#f))))))))
(bloop_0 e45_0)))
(args
(raise-binding-result-arity-error
3
args))))))))
(if (unsafe-fx< index_0 9)
(if (unsafe-fx< index_0 7)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(let ((_0
(let ((s_1 (car s_0)))
s_1)))
(call-with-values
(lambda ()
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax? s_1)
(syntax-e s_1)
s_1)))
(if (pair? s_2)
(let ((e054_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((e55_0
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((flat-s_0
(to-syntax-list.1$1
s_4)))
(if (not
flat-s_0)
(let ((str_0
"bad syntax"))
(error
str_0))
flat-s_0))))))
(let ((e054_1
e054_0))
(values
e054_1
e55_0))))
(let ((str_0
"bad syntax"))
(error str_0))))))
(case-lambda
((e052_0 e53_0)
(let ((_1 _0))
(values _1 e052_0 e53_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(let ((str_0 "bad syntax"))
(error str_0)))))
(case-lambda
((_0 e049_0 e50_0)
(values #t _0 e049_0 e50_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0 _0 e049_0 e50_0)
(if (begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_1
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((result_1
(let ((result_1
(not
(effects?_0
e_1
#f
locals_0))))
(values
result_1))))
(if (if (not
(let ((x_0
(list
e_1)))
(not
result_1)))
#t
#f)
(for-loop_0
result_1
rest_0)
result_1))))
result_0))))))
(for-loop_0 #t e50_0)))
(loop_0 e049_0 locals_0)
#f))
(args
(raise-binding-result-arity-error
4
args))))
(if (unsafe-fx< index_0 8)
(call-with-values
(lambda ()
(if (let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(if (let ((s_1 (car s_0))) #t)
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax? s_1)
(syntax-e s_1)
s_1)))
(if (pair? s_2)
(if (let ((s_3
(car s_2)))
#t)
(let ((s_3
(cdr s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(if (pair? s_4)
(if (let ((s_5
(car
s_4)))
#t)
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (pair?
s_6)
(if (let ((s_7
(car
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(if (pair?
s_8)
(if (let ((s_9
(car
s_8)))
#t)
(let ((s_9
(cdr
s_8)))
(let ((s_10
(if (syntax?
s_9)
(syntax-e
s_9)
s_9)))
(if (pair?
s_10)
(if (let ((s_11
(car
s_10)))
#t)
(let ((s_11
(cdr
s_10)))
(let ((s_12
(if (syntax?
s_11)
(syntax-e
s_11)
s_11)))
(null?
s_12)))
#f)
#f)))
#f)
#f)))
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(null?
s_8)))
#f)
#f)))
#f)
#f)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(let ((mp61_0
(let ((s_1 (car s_0)))
s_1)))
(call-with-values
(lambda ()
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax? s_1)
(syntax-e s_1)
s_1)))
(let ((v66_0
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((g70_0
(let ((s_5
(car
s_4)))
s_5)))
(call-with-values
(lambda ()
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(call-with-values
(lambda ()
(let ((s_7
(car
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(let ((quot75_0
(let ((s_9
(car
s_8)))
s_9)))
(let ((nm76_0
(let ((s_9
(cdr
s_8)))
(let ((s_10
(if (syntax?
s_9)
(syntax-e
s_9)
s_9)))
(let ((nm77_0
(let ((s_11
(car
s_10)))
s_11)))
(call-with-values
(lambda ()
(let ((s_11
(cdr
s_10)))
(let ((s_12
(if (syntax?
s_11)
(syntax-e
s_11)
s_11)))
(values))))
(case-lambda
(()
(let ((nm77_1
nm77_0))
(values
nm77_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((quot75_1
quot75_0))
(values
quot75_1
nm76_0)))))))
(case-lambda
((quot73_0
nm74_0)
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(values))))
(case-lambda
(()
(let ((quot73_1
quot73_0)
(nm74_1
nm74_0))
(values
quot73_1
nm74_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args)))))))
(case-lambda
((quot71_0
nm72_0)
(let ((g70_1
g70_0))
(values
g70_1
quot71_0
nm72_0)))
(args
(raise-binding-result-arity-error
2
args))))))))
(case-lambda
((g67_0
quot68_0
nm69_0)
(let ((v66_1
v66_0))
(values
v66_1
g67_0
quot68_0
nm69_0)))
(args
(raise-binding-result-arity-error
3
args))))))))
(case-lambda
((v62_0
g63_0
quot64_0
nm65_0)
(let ((mp61_1 mp61_0))
(values
mp61_1
v62_0
g63_0
quot64_0
nm65_0)))
(args
(raise-binding-result-arity-error
4
args)))))))
(case-lambda
((mp56_0
v57_0
g58_0
quot59_0
nm60_0)
(values
#t
mp56_0
v57_0
g58_0
quot59_0
nm60_0))
(args
(raise-binding-result-arity-error
5
args))))
(values #f #f #f #f #f #f)))
(case-lambda
((ok?_0
mp56_0
v57_0
g58_0
quot59_0
nm60_0)
(if ok?_0
(if (not
(any-side-effects?.1
hash2610
hash2610
unsafe-undefined
v57_0
1))
(if (eq? 'quote quot59_0)
(if (symbol? nm60_0)
(if (eq? #f g58_0) 1 #f)
#f)
#f)
#f)
#f))
(args
(raise-binding-result-arity-error
6
args))))
(if (ok-make-struct-type?
e_0
ready-variable?_0
known-defns2_0)
5
#f)))
(if (unsafe-fx< index_0 11)
(if (unsafe-fx< index_0 10)
(if (ok-make-struct-field-accessor/mutator?
e_0
locals_0
'general-accessor
known-defns2_0)
1
#f)
(if (ok-make-struct-field-accessor/mutator?
e_0
locals_0
'general-mutator
known-defns2_0)
1
#f))
(if (unsafe-fx< index_0 12)
(if (ok-make-struct-type-property?
e_0
known-defns2_0)
3
#f)
(if (unsafe-fx< index_0 13)
(call-with-values
(lambda ()
(if (let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(if (let ((s_1 (car s_0)))
#t)
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax? s_1)
(syntax-e s_1)
s_1)))
(if (pair? s_2)
(if (let ((s_3
(car
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(if (pair?
s_4)
(if (let ((s_5
(car
s_4)))
#t)
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (pair?
s_6)
(if (let ((s_7
(car
s_6)))
#t)
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(null?
s_8)))
#f)
#f)))
#f)
#f)))
(let ((s_3
(cdr s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(null? s_4)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(let ((gs83_0
(let ((s_1 (car s_0)))
s_1)))
(call-with-values
(lambda ()
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(call-with-values
(lambda ()
(let ((s_3
(car
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((quot88_0
(let ((s_5
(car
s_4)))
s_5)))
(let ((datum89_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(let ((datum90_0
(let ((s_7
(car
s_6)))
s_7)))
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(values))))
(case-lambda
(()
(let ((datum90_1
datum90_0))
(values
datum90_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((quot88_1
quot88_0))
(values
quot88_1
datum89_0)))))))
(case-lambda
((quot86_0
datum87_0)
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(values))))
(case-lambda
(()
(let ((quot86_1
quot86_0)
(datum87_1
datum87_0))
(values
quot86_1
datum87_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args)))))))
(case-lambda
((quot84_0 datum85_0)
(let ((gs83_1 gs83_0))
(values
gs83_1
quot84_0
datum85_0)))
(args
(raise-binding-result-arity-error
2
args)))))))
(case-lambda
((gs80_0 quot81_0 datum82_0)
(values
#t
gs80_0
quot81_0
datum82_0))
(args
(raise-binding-result-arity-error
3
args))))
(values #f #f #f #f)))
(case-lambda
((ok?_0 gs80_0 quot81_0 datum82_0)
(if (let ((or-part_0
(if ok?_0
(if (eq?
'quote
quot81_0)
(let ((or-part_0
(symbol?
datum82_0)))
(if or-part_0
or-part_0
(string?
datum82_0)))
#f)
#f)))
(if or-part_0
or-part_0
(null?
(cdr (correlated-e e_0)))))
1
#f))
(args
(raise-binding-result-arity-error
4
args))))
(call-with-values
(lambda ()
(if (let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(if (let ((s_1 (car s_0)))
#t)
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax? s_1)
(syntax-e s_1)
s_1)))
(if (pair? s_2)
(if (let ((s_3
(car
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(if (pair?
s_4)
(if (let ((s_5
(car
s_4)))
(let ((or-part_0
(if (syntax?
s_5)
(symbol?
(syntax-e
s_5))
#f)))
(if or-part_0
or-part_0
(symbol?
s_5))))
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (pair?
s_6)
(if (let ((s_7
(car
s_6)))
(let ((or-part_0
(if (syntax?
s_7)
(symbol?
(syntax-e
s_7))
#f)))
(if or-part_0
or-part_0
(symbol?
s_7))))
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(null?
s_8)))
#f)
#f)))
#f)
#f)))
(let ((s_3
(cdr s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(if (pair?
s_4)
(if (let ((s_5
(car
s_4)))
#t)
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (pair?
s_6)
(if (let ((s_7
(car
s_6)))
#t)
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(null?
s_8)))
#f)
#f)))
#f)
#f)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(let ((_0
(let ((s_1 (car s_0)))
s_1)))
(call-with-values
(lambda ()
(let ((s_1 (cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(call-with-values
(lambda ()
(let ((s_3
(car
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((id:rator105_0
(let ((s_5
(car
s_4)))
s_5)))
(let ((id:arg106_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(let ((id:arg107_0
(let ((s_7
(car
s_6)))
s_7)))
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(values))))
(case-lambda
(()
(let ((id:arg107_1
id:arg107_0))
(values
id:arg107_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((id:rator105_1
id:rator105_0))
(values
id:rator105_1
id:arg106_0)))))))
(case-lambda
((id:rator101_0
id:arg102_0)
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((thn108_0
(let ((s_5
(car
s_4)))
s_5)))
(let ((els109_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(let ((els110_0
(let ((s_7
(car
s_6)))
s_7)))
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(values))))
(case-lambda
(()
(let ((els110_1
els110_0))
(values
els110_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((thn108_1
thn108_0))
(values
thn108_1
els109_0)))))))
(case-lambda
((thn103_0
els104_0)
(let ((id:rator101_1
id:rator101_0)
(id:arg102_1
id:arg102_0))
(values
id:rator101_1
id:arg102_1
thn103_0
els104_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
2
args)))))))
(case-lambda
((id:rator97_0
id:arg98_0
thn99_0
els100_0)
(let ((_1 _0))
(values
_1
id:rator97_0
id:arg98_0
thn99_0
els100_0)))
(args
(raise-binding-result-arity-error
4
args)))))))
(case-lambda
((_0
id:rator92_0
id:arg93_0
thn94_0
els95_0)
(values
#t
_0
id:rator92_0
id:arg93_0
thn94_0
els95_0))
(args
(raise-binding-result-arity-error
5
args))))
(values #f #f #f #f #f #f)))
(case-lambda
((ok?_0
_0
id:rator92_0
id:arg93_0
thn94_0
els95_0)
(if ok?_0
(let ((c2_0
(let ((or-part_0
(hash-ref
locals_0
id:rator92_0
#f)))
(if or-part_0
or-part_0
(lookup-defn
known-defns2_0
id:rator92_0)))))
(if c2_0
(if (known-predicate? c2_0)
(if (not
(effects?_0
thn94_0
expected-results8_0
(hash-set
locals_0
id:arg93_0
(known-satisfies8.1
(known-predicate-key
c2_0)))))
(loop_0 els95_0 locals_0)
#f)
#f)
#f))
(call-with-values
(lambda ()
(if (let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(if (pair? s_0)
(if (let ((s_1
(car s_0)))
#t)
(let ((s_1
(cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(if (pair? s_2)
(if (let ((s_3
(car
s_2)))
#t)
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(if (pair?
s_4)
(if (let ((s_5
(car
s_4)))
#t)
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(if (pair?
s_6)
(if (let ((s_7
(car
s_6)))
#t)
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(null?
s_8)))
#f)
#f)))
#f)
#f)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_0
(if (syntax? e_0)
(syntax-e e_0)
e_0)))
(let ((_1
(let ((s_1
(car
s_0)))
s_1)))
(call-with-values
(lambda ()
(let ((s_1
(cdr s_0)))
(let ((s_2
(if (syntax?
s_1)
(syntax-e
s_1)
s_1)))
(let ((tst119_0
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?
s_3)
(syntax-e
s_3)
s_3)))
(let ((thn122_0
(let ((s_5
(car
s_4)))
s_5)))
(let ((els123_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?
s_5)
(syntax-e
s_5)
s_5)))
(let ((els124_0
(let ((s_7
(car
s_6)))
s_7)))
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?
s_7)
(syntax-e
s_7)
s_7)))
(values))))
(case-lambda
(()
(let ((els124_1
els124_0))
(values
els124_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((thn122_1
thn122_0))
(values
thn122_1
els123_0)))))))
(case-lambda
((thn120_0
els121_0)
(let ((tst119_1
tst119_0))
(values
tst119_1
thn120_0
els121_0)))
(args
(raise-binding-result-arity-error
2
args))))))))
(case-lambda
((tst116_0
thn117_0
els118_0)
(let ((_2 _1))
(values
_2
tst116_0
thn117_0
els118_0)))
(args
(raise-binding-result-arity-error
3
args)))))))
(case-lambda
((_1
tst112_0
thn113_0
els114_0)
(values
#t
_1
tst112_0
thn113_0
els114_0))
(args
(raise-binding-result-arity-error
4
args))))
(values #f #f #f #f #f)))
(case-lambda
((ok?_1
_1
tst112_0
thn113_0
els114_0)
(if ok?_1
(if (not
(effects?_0
tst112_0
1
locals_0))
(if (not
(effects?_0
thn113_0
expected-results8_0
locals_0))
(loop_0
els114_0
locals_0)
#f)
#f)
#f))
(args
(raise-binding-result-arity-error
5
args))))))
(args
(raise-binding-result-arity-error
6
args))))))))))))))))
(loop_0 e7_0 known-locals1_0))))
(not
(if actual-results_0
(let ((or-part_0 (not expected-results8_0)))
(if or-part_0
or-part_0
(= actual-results_0 expected-results8_0)))
#f)))))))))
(define satisfies?
(lambda (e_0 key_0 defns_0 locals_0)
(let ((d_0
(let ((or-part_0 (hash-ref locals_0 e_0 #f)))
(if or-part_0 or-part_0 (lookup-defn defns_0 e_0)))))
(if d_0
(if (known-satisfies? d_0)
(eq? key_0 (known-satisfies-predicate-key d_0))
#f)
#f))))
(define add-binding-info
(lambda (locals_0 idss_0 rhss_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (locals_1 lst_0 lst_1)
(begin
(if (if (pair? lst_0) (pair? lst_1) #f)
(let ((ids_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((rhs_0 (unsafe-car lst_1)))
(let ((rest_1 (unsafe-cdr lst_1)))
(let ((locals_2
(let ((locals_2
(letrec*
((loop_0
(|#%name|
loop
(lambda (rhs_1)
(begin
(let ((tmp_0
(if (pair?
(correlated-e rhs_1))
(correlated-e
(car
(correlated-e rhs_1)))
#f)))
(if (eq?
tmp_0
'make-struct-type)
(let ((field-count_0
(extract-struct-field-count-lower-bound
rhs_1)))
(let ((lst_2
(correlated->list
ids_0)))
(let ((lst_3
'(struct-type
constructor
predicate
general-accessor
general-mutator)))
(let ((lst_4 lst_2))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (locals_2
lst_5
lst_6)
(begin
(if (if (pair?
lst_5)
(pair?
lst_6)
#f)
(let ((id_0
(unsafe-car
lst_5)))
(let ((rest_2
(unsafe-cdr
lst_5)))
(let ((type_0
(unsafe-car
lst_6)))
(let ((rest_3
(unsafe-cdr
lst_6)))
(let ((locals_3
(let ((locals_3
(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
locals_3
rest_2
rest_3))))))
locals_2))))))
(for-loop_1
locals_1
lst_4
lst_3)))))))
(if (eq? tmp_0 'let-values)
(if (null?
(correlated-e
(correlated-cadr
rhs_1)))
(loop_0
(caddr
(correlated->list
rhs_1)))
(loop_0 #f))
(let ((ids*_0
(correlated->list
ids_0)))
(if (if (pair? ids*_0)
(null?
(cdr ids*_0))
#f)
(let ((app_0
(correlated-e
(car ids*_0))))
(hash-set
locals_1
app_0
(infer-known
rhs_1)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (locals_2
lst_2)
(begin
(if (pair?
lst_2)
(let ((id_0
(unsafe-car
lst_2)))
(let ((rest_2
(unsafe-cdr
lst_2)))
(let ((locals_3
(let ((locals_3
(hash-set
locals_2
(correlated-e
id_0)
#t)))
(values
locals_3))))
(for-loop_1
locals_3
rest_2))))
locals_2))))))
(for-loop_1
locals_1
ids*_0)))))))))))))
(loop_0 rhs_0))))
(values locals_2))))
(for-loop_0 locals_2 rest_0 rest_1))))))
locals_1))))))
(for-loop_0 locals_0 idss_0 rhss_0)))))
(define infer-known
(lambda (e_0)
(let ((tmp_0
(if (pair? (correlated-e e_0))
(correlated-e (car (correlated-e e_0)))
#f)))
(if (if (eq? tmp_0 'lambda) #t (eq? tmp_0 'case-lambda))
(known-satisfies8.1 'procedure)
#t))))
(define ok-make-struct-type-property?
(lambda (e_0 defns_0)
(let ((l_0 (correlated->list e_0)))
(if (<= 2 (length l_0) 5)
(let ((lst_0 (cdr l_0)))
(let ((lst_1
(list
(lambda (v_0) (quoted? symbol? v_0))
(lambda (v_0) (is-lambda? v_0 2 defns_0))
(lambda (v_0)
(ok-make-struct-type-property-super? v_0 defns_0))
(lambda (v_0)
(not
(any-side-effects?.1
defns_0
hash2610
unsafe-undefined
v_0
1))))))
(let ((lst_2 lst_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_3 lst_4)
(begin
(if (if (pair? lst_3) (pair? lst_4) #f)
(let ((arg_0 (unsafe-car lst_3)))
(let ((rest_0 (unsafe-cdr lst_3)))
(let ((pred_0 (unsafe-car lst_4)))
(let ((rest_1 (unsafe-cdr lst_4)))
(let ((result_1
(let ((result_1
(|#%app| pred_0 arg_0)))
(values result_1))))
(if (if (not
(let ((x_0 (list arg_0)))
(not result_1)))
(if (not
(let ((x_0 (list pred_0)))
(not result_1)))
#t
#f)
#f)
(for-loop_0 result_1 rest_0 rest_1)
result_1))))))
result_0))))))
(for-loop_0 #t lst_2 lst_1))))))
#f))))
(define ok-make-struct-type-property-super?
(lambda (v_0 defns_0)
(let ((or-part_0 (quoted? null? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (eq? 'null (correlated-e v_0))))
(if or-part_1
or-part_1
(if (pair? (correlated-e v_0))
(if (eq? (correlated-e (car (correlated-e v_0))) 'list)
(if (let ((lst_0 (cdr (correlated->list v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((prop+val_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1
(let ((result_1
(if (=
(correlated-length
prop+val_0)
3)
(let ((prop+val_1
(correlated->list
prop+val_0)))
(if (eq?
'cons
(correlated-e
(car
prop+val_1)))
(if (let ((or-part_2
(memq
(correlated-e
(list-ref
prop+val_1
1))
'(prop:procedure
prop:equal+hash))))
(if or-part_2
or-part_2
(let ((o_0
(lookup-defn
defns_0
(correlated-e
(list-ref
prop+val_1
1)))))
(let ((or-part_3
(known-property?
o_0)))
(if or-part_3
or-part_3
(known-property-of-function?
o_0))))))
(not
(let ((temp128_0
(list-ref
prop+val_1
2)))
(any-side-effects?.1
defns_0
hash2610
unsafe-undefined
temp128_0
1)))
#f)
#f))
#f)))
(values result_1))))
(if (if (not
(let ((x_0 (list prop+val_0)))
(not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t lst_0))))
(let ((app_0 (sub1 (correlated-length v_0))))
(=
app_0
(let ((s_0
(let ((lst_0 (cdr (correlated->list v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_1)
(begin
(if (pair? lst_1)
(let ((prop+val_0
(unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
(correlated-e
(list-ref
(correlated->list
prop+val_0)
1))
#t))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 lst_0))))))
(begin-unsafe (hash-count s_0)))))
#f)
#f)
#f)))))))
(define ok-make-struct-type?
(lambda (e_0 ready-variable?_0 defns_0)
(let ((l_0 (correlated->list e_0)))
(let ((init-field-count-expr_0
(if (> (length l_0) 3) (list-ref l_0 3) #f)))
(let ((auto-field-count-expr_0
(if (> (length l_0) 4) (list-ref l_0 4) #f)))
(let ((num-fields_0
(let ((app_0
(field-count-expr-to-field-count
init-field-count-expr_0)))
(maybe+
app_0
(field-count-expr-to-field-count
auto-field-count-expr_0)))))
(let ((immutables-expr_0
(let ((or-part_0
(if (> (length l_0) 9) (list-ref l_0 9) #f)))
(if or-part_0 or-part_0 'null))))
(let ((super-expr_0 (if (> (length l_0) 2) (list-ref l_0 2) #f)))
(if (>= (length l_0) 5)
(if (<= (length l_0) 12)
(let ((lst_0 (cdr l_0)))
(let ((lst_1
(list
(lambda (v_0) (quoted? symbol? v_0))
(lambda (v_0) (super-ok? v_0 defns_0))
(lambda (v_0)
(field-count-expr-to-field-count v_0))
(lambda (v_0)
(field-count-expr-to-field-count v_0))
(lambda (v_0)
(not
(any-side-effects?.1
defns_0
hash2610
ready-variable?_0
v_0
1)))
(lambda (v_0)
(known-good-struct-properties?
v_0
immutables-expr_0
super-expr_0
defns_0))
(lambda (v_0) (inspector-or-false? v_0))
(lambda (v_0) (procedure-spec? v_0 num-fields_0))
(lambda (v_0)
(immutables-ok?
v_0
init-field-count-expr_0)))))
(let ((lst_2 lst_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_3 lst_4)
(begin
(if (if (pair? lst_3) (pair? lst_4) #f)
(let ((arg_0 (unsafe-car lst_3)))
(let ((rest_0 (unsafe-cdr lst_3)))
(let ((pred_0 (unsafe-car lst_4)))
(let ((rest_1 (unsafe-cdr lst_4)))
(let ((result_1
(let ((result_1
(|#%app|
pred_0
arg_0)))
(values result_1))))
(if (if (not
(let ((x_0
(list arg_0)))
(not result_1)))
(if (not
(let ((x_0
(list
pred_0)))
(not result_1)))
#t
#f)
#f)
(for-loop_0
result_1
rest_0
rest_1)
result_1))))))
result_0))))))
(for-loop_0 #t lst_2 lst_1))))))
#f)
#f)))))))))
(define super-ok?
(lambda (e_0 defns_0)
(let ((or-part_0 (quoted? false? e_0)))
(if or-part_0
or-part_0
(let ((o_0 (lookup-defn defns_0 (correlated-e e_0))))
(if o_0
(if (known-struct-op? o_0)
(eq? 'struct-type (known-struct-op-type o_0))
#f)
#f))))))
(define extract-struct-field-count-lower-bound
(lambda (e_0)
(let ((l_0 (correlated->list e_0)))
(let ((app_0 (field-count-expr-to-field-count (list-ref l_0 3))))
(+ app_0 (field-count-expr-to-field-count (list-ref l_0 4)))))))
(define quoted?
(lambda (val?_0 v_0)
(let ((or-part_0
(if (pair? (correlated-e v_0))
(if (eq? (correlated-e (car (correlated-e v_0))) 'quote)
(|#%app| val?_0 (correlated-e (correlated-cadr v_0)))
#f)
#f)))
(if or-part_0 or-part_0 (|#%app| val?_0 (correlated-e v_0))))))
(define quoted-value
(lambda (v_0)
(if (pair? (correlated-e v_0))
(correlated-e (correlated-cadr v_0))
(correlated-e v_0))))
(define false? (lambda (v_0) (eq? (correlated-e v_0) #f)))
(define field-count-expr-to-field-count
(lambda (v_0)
(if (quoted? exact-nonnegative-integer? v_0) (quoted-value v_0) #f)))
(define inspector-or-false?
(lambda (v_0)
(let ((or-part_0 (quoted? false? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(if (quoted? symbol? v_0) (eq? 'prefab (quoted-value v_0)) #f)))
(if or-part_1
or-part_1
(if (= 1 (correlated-length v_0))
(eq? 'current-inspector (correlated-e (car (correlated-e v_0))))
#f)))))))
(define known-good-struct-properties?
(lambda (v_0 immutables-expr_0 super-expr_0 defns_0)
(let ((or-part_0 (quoted? null? v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (eq? 'null (correlated-e v_0))))
(if or-part_1
or-part_1
(if (pair? (correlated-e v_0))
(if (eq? (correlated-e (car (correlated-e v_0))) 'list)
(if (let ((lst_0 (cdr (correlated->list v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((prop+val_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1
(let ((result_1
(if (=
(correlated-length
prop+val_0)
3)
(let ((prop+val_1
(correlated->list
prop+val_0)))
(if (eq?
'cons
(correlated-e
(car
prop+val_1)))
(let ((app_0
(list-ref
prop+val_1
1)))
(known-good-struct-property+value?
app_0
(list-ref
prop+val_1
2)
immutables-expr_0
super-expr_0
defns_0))
#f))
#f)))
(values result_1))))
(if (if (not
(let ((x_0 (list prop+val_0)))
(not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t lst_0))))
(let ((app_0 (sub1 (correlated-length v_0))))
(=
app_0
(let ((s_0
(let ((lst_0 (cdr (correlated->list v_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_1)
(begin
(if (pair? lst_1)
(let ((prop+val_0
(unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
(correlated-e
(list-ref
(correlated->list
prop+val_0)
1))
#t))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 lst_0))))))
(begin-unsafe (hash-count s_0)))))
#f)
#f)
#f)))))))
(define known-good-struct-property+value?
(lambda (prop-expr_0 val-expr_0 immutables-expr_0 super-expr_0 defns_0)
(let ((prop-name_0 (correlated-e prop-expr_0)))
(if (eq? prop-name_0 'prop:evt)
(let ((or-part_0 (is-lambda? val-expr_0 1 defns_0)))
(if or-part_0
or-part_0
(immutable-field? val-expr_0 immutables-expr_0)))
(if (eq? prop-name_0 'prop:procedure)
(let ((or-part_0 (is-lambda? val-expr_0 1 defns_0)))
(if or-part_0
or-part_0
(immutable-field? val-expr_0 immutables-expr_0)))
(if (eq? prop-name_0 'prop:equal+hash)
(let ((l_0 (correlated->list val-expr_0)))
(if (eq? 'list (car l_0))
(if (is-lambda? (list-ref l_0 1) 3 defns_0)
(if (is-lambda? (list-ref l_0 2) 2 defns_0)
(is-lambda? (list-ref l_0 3) 2 defns_0)
#f)
#f)
#f))
(if (eq? prop-name_0 'prop:checked-procedure)
(if (quoted? false? super-expr_0)
(immutable-field? 1 immutables-expr_0)
#f)
(let ((o_0 (lookup-defn defns_0 prop-name_0)))
(if (known-property? o_0)
(not
(any-side-effects?.1
defns_0
hash2610
unsafe-undefined
val-expr_0
1))
(if (known-property-of-function? o_0)
(is-lambda?
val-expr_0
(known-property-of-function-arity o_0)
defns_0)
#f))))))))))
(define is-lambda?
(lambda (expr_0 arity_0 defns_0)
(let ((lookup_0 (lookup-defn defns_0 expr_0)))
(let ((or-part_0
(if lookup_0
(if (known-function? lookup_0)
(let ((or-part_0 (not arity_0)))
(if or-part_0
or-part_0
(arity-includes?
(known-function-arity lookup_0)
arity_0)))
#f)
#f)))
(if or-part_0
or-part_0
(let ((or-part_1
(if (pair? (correlated-e expr_0))
(if (eq? 'case-lambda (car (correlated-e expr_0)))
(not arity_0)
#f)
#f)))
(if or-part_1
or-part_1
(if (pair? (correlated-e expr_0))
(if (eq? 'lambda (car (correlated-e expr_0)))
(let ((or-part_2 (not arity_0)))
(if or-part_2
or-part_2
(letrec*
((loop_0
(|#%name|
loop
(lambda (args_0 arity_1)
(begin
(if (begin-unsafe (syntax? args_0))
(loop_0 (correlated-e args_0) arity_1)
(if (null? args_0)
(zero? arity_1)
(if (pair? args_0)
(let ((app_0 (cdr args_0)))
(loop_0 app_0 (sub1 arity_1)))
(not (negative? arity_1))))))))))
(loop_0 (cadr (correlated->list expr_0)) arity_0))))
#f)
#f))))))))
(define arity-includes?
(lambda (a_0 n_0)
(let ((or-part_0 (equal? a_0 n_0)))
(if or-part_0
or-part_0
(if (list? a_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((a_1 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1 (equal? a_1 n_0)))
(values result_1))))
(if (if (not (let ((x_0 (list a_1))) result_1))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #f a_0)))
#f)))))
(define immutable-field?
(lambda (val-expr_0 immutables-expr_0)
(if (quoted? exact-nonnegative-integer? val-expr_0)
(let ((app_0 (quoted-value val-expr_0)))
(memv app_0 (immutables-expr-to-immutables immutables-expr_0 null)))
#f)))
(define immutables-expr-to-immutables
(lambda (e_0 fail-v_0)
(let ((tmp_0
(if (pair? (correlated-e e_0))
(correlated-e (car (correlated-e e_0)))
#f)))
(if (eq? tmp_0 'quote)
(let ((v_0 (correlated-cadr e_0)))
(let ((or-part_0
(if (correlated-length v_0)
(let ((l_0 (map_1346 correlated-e (correlated->list v_0))))
(if (andmap_2344 exact-nonnegative-integer? l_0)
(if (let ((app_0 (length l_0)))
(=
app_0
(let ((s_0 (list->set l_0)))
(begin-unsafe (hash-count s_0)))))
l_0
#f)
#f))
#f)))
(if or-part_0 or-part_0 fail-v_0)))
fail-v_0))))
(define procedure-spec?
(lambda (e_0 field-count_0)
(let ((or-part_0 (quoted? false? e_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(if (quoted? exact-nonnegative-integer? e_0)
(if field-count_0 (< (quoted-value e_0) field-count_0) #f)
#f)))
(if or-part_1 or-part_1 (is-lambda? e_0 #f hash2610)))))))
(define immutables-ok?
(lambda (e_0 init-field-count-expr_0)
(let ((l_0 (immutables-expr-to-immutables e_0 #f)))
(let ((c_0 (field-count-expr-to-field-count init-field-count-expr_0)))
(if l_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((n_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1 (< n_0 c_0)))
(values result_1))))
(if (if (not
(let ((x_0 (list n_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t l_0)))
#f)))))
(define ok-make-struct-field-accessor/mutator?
(lambda (e_0 locals_0 type_0 defns_0)
(let ((l_0 (correlated->list e_0)))
(let ((a_0
(if (let ((or-part_0 (= (length l_0) 3)))
(if or-part_0 or-part_0 (= (length l_0) 4)))
(let ((or-part_0
(hash-ref locals_0 (correlated-e (list-ref l_0 1)) #f)))
(if or-part_0
or-part_0
(lookup-defn defns_0 (correlated-e (list-ref l_0 1)))))
#f)))
(if (known-struct-op? a_0)
(if (eq? (known-struct-op-type a_0) type_0)
(if (let ((c_0 (field-count-expr-to-field-count (list-ref l_0 2))))
(if c_0 (< c_0 (known-struct-op-field-count a_0)) #f))
(let ((or-part_0 (= (length l_0) 3)))
(if or-part_0 or-part_0 (quoted? symbol? (list-ref l_0 3))))
#f)
#f)
#f)))))
(define maybe+ (lambda (x_0 y_0) (if x_0 (if y_0 (+ x_0 y_0) #f) #f)))
(define compile-single
(lambda (p_0 cctx_0) (compile-top.1 #f #t #f p_0 cctx_0)))
(define compile-top.1
(|#%name|
compile-top
(lambda (serializable?1_0
single-expression?2_0
to-correlated-linklet?3_0
p7_0
cctx8_0)
(begin
(begin
(if log-performance?
(start-performance-region
'compile
(if single-expression?2_0 'transformer 'top))
(void))
(begin0
(let ((phase_0 (compile-context-phase cctx8_0)))
(let ((mpis_0 (make-module-path-index-table)))
(let ((purely-functional?_0 #t))
(call-with-values
(lambda ()
(let ((temp14_0 (list p7_0)))
(let ((temp17_0
(if single-expression?2_0
(list* '() (list syntax-literals-id) '(()))
(list
(list top-level-bind!-id top-level-require!-id)
(list mpi-vector-id syntax-literals-id)
instance-imports))))
(let ((temp18_0
(list
top-level-instance
empty-top-syntax-literal-instance
empty-instance-instance)))
(let ((temp21_0
(lambda () (set! purely-functional?_0 #f))))
(let ((temp22_0
(lambda (e_0
expected-results_0
phase_1
required-reference?_0)
(if (if purely-functional?_0
(any-side-effects?.1
hash2610
hash2610
required-reference?_0
e_0
expected-results_0)
#f)
(set! purely-functional?_0 #f)
(void)))))
(let ((temp23_0
(lambda (s_0 cctx_0)
(begin
(set! purely-functional?_0 #f)
(compile-top-level-require
s_0
cctx_0)))))
(let ((temp24_0 (not single-expression?2_0)))
(let ((temp23_1 temp23_0)
(temp22_1 temp22_0)
(temp21_1 temp21_0)
(temp18_1 temp18_0)
(temp17_1 temp17_0)
(temp14_1 temp14_0))
(compile-forms.1
temp18_1
temp17_1
null
temp22_1
temp21_1
#f
null
unsafe-undefined
#f
temp24_0
temp23_1
#f
serializable?1_0
to-correlated-linklet?3_0
#f
temp14_1
cctx8_0
mpis_0))))))))))
(case-lambda
((body-linklets_0
min-phase_0
max-phase_0
phase-to-link-module-uses_0
phase-to-link-module-uses-expr_0
phase-to-link-extra-inspectorss_0
syntax-literals_0
no-root-context-pos_0)
(let ((add-metadata_0
(|#%name|
add-metadata
(lambda (ht_0)
(begin
(let ((ht_1
(hash-set
ht_0
'original-phase
phase_0)))
(let ((ht_2
(hash-set
ht_1
'max-phase
max-phase_0)))
ht_2)))))))
(let ((bundle_0
(hash->linklet-bundle
(add-metadata_0
(if serializable?1_0
(let ((syntax-literals-expr_0
(begin
(if log-performance?
(start-performance-region
'compile
'top
'serialize)
(void))
(begin0
(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 ((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?
(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))))
(let ((app_1 (current-code-inspector)))
(let ((app_2 (mpis-as-vector mpis_0)))
(let ((app_3
(syntax-literals-as-vector
syntax-literals_0)))
(let ((app_4
(extract-namespace-scopes
(compile-context-namespace cctx8_0))))
(compiled-in-memory1.1
app_0
#f
#f
#f
phase-to-link-module-uses_0
app_1
phase-to-link-extra-inspectorss_0
app_2
app_3
null
null
app_4
purely-functional?_0)))))))))
(args (raise-binding-result-arity-error 8 args)))))))
(if log-performance? (end-performance-region) (void))))))))
(define compile-top-level-require
(lambda (p_0 cctx_0)
(let ((phase_0 (compile-context-phase cctx_0)))
(if (parsed-require? p_0)
(let ((form-stx_0
(compile-quote-syntax (syntax-disarm$1 (parsed-s p_0)) cctx_0)))
(list top-level-require!-id form-stx_0 ns-id))
#f))))
(define select-defined-syms-and-bind!.1
(|#%name|
select-defined-syms-and-bind!
(lambda (as-transformer?5_0
frame-id1_0
in4_0
requires+provides3_0
top-level-bind-scope2_0
ids11_0
defined-syms12_0
self13_0
phase14_0
all-scopes-stx15_0)
(begin
(let ((defined-syms-at-phase_0
(let ((or-part_0 (hash-ref defined-syms12_0 phase14_0 #f)))
(if or-part_0
or-part_0
(let ((ht_0 (make-hasheq)))
(begin
(hash-set! defined-syms12_0 phase14_0 ht_0)
ht_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((sym_0 (syntax-e$1 id_0)))
(let ((defined-sym_0
(if (if (not
(defined-as-other?
(hash-ref
defined-syms-at-phase_0
sym_0
#f)
id_0
phase14_0
top-level-bind-scope2_0))
(if (no-extra-scopes?
id_0
all-scopes-stx15_0
top-level-bind-scope2_0
phase14_0)
(symbol-interned?
sym_0)
#f)
#f)
sym_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (pos_0)
(begin
(let ((s_0
(string->unreadable-symbol
(let ((app_0
(symbol->string
sym_0)))
(string-append
app_0
"."
(number->string
pos_0))))))
(if (defined-as-other?
(hash-ref
defined-syms-at-phase_0
s_0
#f)
id_0
phase14_0
top-level-bind-scope2_0)
(loop_0
(add1 pos_0))
s_0)))))))
(loop_0 1)))))
(begin
(hash-set!
defined-syms-at-phase_0
defined-sym_0
id_0)
(let ((b_0
(make-module-binding.1
#f
null
frame-id1_0
#f
unsafe-undefined
unsafe-undefined
0
sym_0
self13_0
phase14_0
defined-sym_0)))
(begin
(if requires+provides3_0
(remove-required-id!.1
b_0
requires+provides3_0
id_0
phase14_0)
(void))
(add-binding!.1
in4_0
#f
id_0
b_0
phase14_0)
(if requires+provides3_0
(add-defined-or-required-id!.1
as-transformer?5_0
#f
requires+provides3_0
id_0
phase14_0
b_0)
(void))
defined-sym_0)))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null ids11_0)))))))))
(define no-extra-scopes?
(lambda (id_0 all-scopes-stx_0 top-level-bind-scope_0 phase_0)
(let ((m-id_0 (datum->syntax$1 all-scopes-stx_0 (syntax-e$1 id_0))))
(let ((or-part_0 (bound-identifier=?$1 id_0 m-id_0 phase_0)))
(if or-part_0
or-part_0
(if top-level-bind-scope_0
(bound-identifier=?$1
id_0
(add-scope m-id_0 top-level-bind-scope_0)
phase_0)
#f))))))
(define defined-as-other?
(lambda (prev-id_0 id_0 phase_0 top-level-bind-scope_0)
(if prev-id_0
(if (not (bound-identifier=?$1 prev-id_0 id_0 phase_0))
(let ((or-part_0 (not top-level-bind-scope_0)))
(if or-part_0
or-part_0
(not
(let ((app_0 (remove-scope prev-id_0 top-level-bind-scope_0)))
(bound-identifier=?$1
app_0
(remove-scope id_0 top-level-bind-scope_0)
phase_0)))))
#f)
#f)))
(define select-defined-syms-and-bind!/ctx
(lambda (tl-ids_0 ctx_0)
(let ((temp36_0
(begin-unsafe
(root-expand-context/inner-defined-syms
(root-expand-context/outer-inner ctx_0)))))
(let ((temp37_0
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner ctx_0)))))
(let ((temp38_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((temp39_0
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner ctx_0)))))
(let ((temp40_0
(begin-unsafe (root-expand-context/outer-frame-id ctx_0))))
(let ((temp41_0
(begin-unsafe
(root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner ctx_0)))))
(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
(let ((or-part_0 (hash-ref defined-syms_0 phase_0 #f)))
(if or-part_0
or-part_0
(let ((ht_0 (make-hasheq)))
(begin (hash-set! defined-syms_0 phase_0 ht_0) ht_0))))))
(hash-set! defined-syms-at-phase_0 sym_0 id_0))))
(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 ((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
(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
(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
(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
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner root-context_0)))))
(let ((inside-mpi_0
(make-self-module-path-index
(module-path-index-resolved outside-mpi_0))))
(if (root-expand-context/outer? 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 ((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)))
(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))))
(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?"
root-context_0))))))
(define initial-code-inspector (current-code-inspector))
(define check-require-access.1
(|#%name|
check-require-access
(lambda (skip-imports1_0
linklet3_0
import-module-uses4_0
import-module-instances5_0
insp6_0
extra-inspector7_0
extra-inspectorsss8_0)
(begin
(begin
(let ((lst_0
(list-tail
(linklet-import-variables linklet3_0)
skip-imports1_0)))
(let ((lst_1
(if extra-inspectorsss8_0
extra-inspectorsss8_0
import-module-uses4_0)))
(let ((lst_2 lst_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_3 lst_4 lst_5 lst_6)
(begin
(if (if (pair? lst_3)
(if (pair? lst_4)
(if (pair? lst_5) (pair? lst_6) #f)
#f)
#f)
(let ((import-syms_0 (unsafe-car lst_3)))
(let ((rest_0 (unsafe-cdr lst_3)))
(let ((mu_0 (unsafe-car lst_4)))
(let ((rest_1 (unsafe-cdr lst_4)))
(let ((mi_0 (unsafe-car lst_5)))
(let ((rest_2 (unsafe-cdr lst_5)))
(let ((extra-inspectorss_0
(unsafe-car lst_6)))
(let ((rest_3 (unsafe-cdr lst_6)))
(begin
(let ((m_0
(module-instance-module
mi_0)))
(if (module-no-protected? m_0)
(void)
(let ((access_0
(let ((or-part_0
(module-access
m_0)))
(if or-part_0
or-part_0
(module-compute-access!
m_0)))))
(begin
(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
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
#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)))))
(for-loop_0
rest_0
rest_1
rest_2
rest_3))))))))))
(values)))))))
(for-loop_0
lst_2
import-module-uses4_0
import-module-instances5_0
lst_1))))))
(void))))))
(define check-single-require-access
(lambda (mi_0 phase_0 sym_0 insp_0)
(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)))))))
(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))))
(define make-module-cache-key
(lambda (hash-code_0)
(if hash-code_0
(string->symbol
(format
"~s"
(list
hash-code_0
(path->directory-path
(let ((or-part_0 (current-load-relative-directory)))
(if or-part_0 or-part_0 (current-directory)))))))
#f)))
(define module-cache-set!
(lambda (key_0 proc_0)
(hash-set!
(unsafe-place-local-ref cell.1$3)
key_0
(make-ephemeron key_0 proc_0))))
(define module-cache-ref
(lambda (key_0)
(let ((e_0 (hash-ref (unsafe-place-local-ref cell.1$3) key_0 #f)))
(if e_0 (ephemeron-value e_0) #f))))
(define current-module-declare-as-predefined
(make-parameter #f #f 'current-module-declare-as-predefined))
(define eval-module.1
(|#%name|
eval-module
(lambda (namespace1_0 supermodule-name3_0 with-submodules?2_0 c7_0)
(begin
(let ((ns_0
(if (eq? namespace1_0 unsafe-undefined)
(1/current-namespace)
namespace1_0)))
(begin
(if log-performance?
(start-performance-region 'eval 'module)
(void))
(begin0
(call-with-values
(lambda ()
(compiled-module->dh+h+data-instance+declaration-instance
c7_0))
(case-lambda
((dh_0 h_0 data-instance_0 declaration-instance_0)
(let ((syntax-literals-data-instance_0
(if (compiled-in-memory? c7_0)
(make-syntax-literal-data-instance-from-compiled-in-memory
c7_0)
(let ((l_0 (hash-ref h_0 'stx-data #f)))
(if l_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)
empty-syntax-literals-instance/empty-namespace
empty-syntax-literals-data-instance))))))
(let ((decl_0
(|#%name|
decl
(lambda (key_0)
(begin
(instance-variable-value
declaration-instance_0
key_0))))))
(let ((pre-submodule-names_0 (hash-ref h_0 'pre null)))
(let ((post-submodule-names_0 (hash-ref h_0 'post null)))
(let ((default-name_0 (hash-ref h_0 'name 'module)))
(let ((cache-key_0
(make-module-cache-key
(if (null? pre-submodule-names_0)
(if (null? post-submodule-names_0)
(hash-ref h_0 'hash-code #f)
#f)
#f))))
(let ((cross-phase-persistent?_0
(hash-ref h_0 'cross-phase-persistent? #f)))
(let ((min-phase_0 (hash-ref h_0 'min-phase 0)))
(let ((max-phase_0
(hash-ref h_0 'max-phase 0)))
(let ((language-info_0
(hash-ref h_0 'language-info #f)))
(let ((phases-h_0
(let ((end_0 (add1 max-phase_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((table_1
(let ((v_0
(hash-ref
h_0
pos_0
#f)))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(if v_0
(let ((table_2
(call-with-values
(lambda ()
(values
pos_0
(begin-unsafe
(eval-linklet
(force-compile-linklet
v_0)))))
(case-lambda
((key_0
val_0)
(hash-set
table_1
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_2))
table_1)))
table_2))))))
(for-loop_1
table_0))))))
(for-loop_0
table_1
(+ pos_0 1)))
table_0))))))
(for-loop_0
hash2725
min-phase_0))))))
(let ((syntax-literals-linklet_0
(let ((l_0
(hash-ref h_0 'stx #f)))
(if l_0
(begin-unsafe
(eval-linklet
(force-compile-linklet
l_0)))
#f))))
(let ((extra-inspector_0
(if (compiled-in-memory? c7_0)
(compiled-in-memory-compile-time-inspector
c7_0)
#f)))
(let ((phase-to-link-extra-inspectorsss_0
(if (compiled-in-memory? c7_0)
(compiled-in-memory-phase-to-link-extra-inspectorsss
c7_0)
hash2589)))
(let ((requires_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'requires)))))
(let ((provides_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'provides)))))
(let ((original-self_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'self-mpi)))))
(let ((phase-to-link-modules_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'phase-to-link-modules)))))
(let ((create-root-expand-context-from-module_0
(make-create-root-expand-context-from-module
requires_0
phases-h_0)))
(let ((declare-submodules_0
(if dh_0
(|#%name|
declare-submodules
(lambda (ns_1
names_0
declare-name_0
pre?_0)
(begin
(if (compiled-in-memory?
c7_0)
(begin
(let ((lst_0
(if pre?_0
(compiled-in-memory-pre-compiled-in-memorys
c7_0)
(compiled-in-memory-post-compiled-in-memorys
c7_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair?
lst_1)
(let ((c_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(eval-module.1
ns_1
declare-name_0
#t
c_0)
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
lst_0))))
(void))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair?
lst_0)
(let ((name_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(let ((sm-cd_0
(hash-ref
dh_0
name_0
#f)))
(begin
(if sm-cd_0
(void)
(error
"missing submodule declaration:"
name_0))
(eval-module.1
ns_1
declare-name_0
#t
sm-cd_0)))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
names_0)))
(void))))))
void)))
(let ((declare-this-module_0
(|#%name|
declare-this-module
(lambda (ns_1)
(begin
(let ((m_0
(let ((temp20_0
(1/current-module-declare-source)))
(let ((temp28_0
(current-module-declare-as-predefined)))
(let ((temp29_0
(append
pre-submodule-names_0
post-submodule-names_0)))
(let ((temp31_0
(lambda ()
(get-all-variables
phases-h_0))))
(let ((temp32_0
(lambda (phase-level_0
ns_2
insp_0)
(let ((app_0
(hash-ref
phases-h_0
phase-level_0
#f)))
(let ((app_1
(hash-ref
phase-to-link-modules_0
phase-level_0
#f)))
(module-linklet-info2.1
app_0
app_1
original-self_0
insp_0
extra-inspector_0
(hash-ref
phase-to-link-extra-inspectorsss_0
phase-level_0
#f)))))))
(let ((temp33_0
(lambda (bulk-binding-registry_0)
(force-syntax-deserialize
syntax-literals-data-instance_0
bulk-binding-registry_0))))
(let ((temp34_0
(lambda (data-box_0
ns_2
phase-shift_0
self_0
bulk-binding-registry_0
insp_0)
(if (unbox
data-box_0)
(void)
(init-instance-data!
data-box_0
cache-key_0
ns_2
syntax-literals-linklet_0
data-instance_0
syntax-literals-data-instance_0
phase-shift_0
original-self_0
self_0
bulk-binding-registry_0
insp_0
create-root-expand-context-from-module_0)))))
(let ((temp35_0
(lambda (data-box_0
ns_2
phase-shift_0
phase-level_0
self_0
bulk-binding-registry_0
insp_0)
(begin
(if log-performance?
(start-performance-region
'eval
'instantiate)
(void))
(begin0
(let ((syntax-literals-instance_0
(instance-data-syntax-literals-instance
(unbox
data-box_0))))
(let ((phase-linklet_0
(hash-ref
phases-h_0
phase-level_0
#f)))
(if phase-linklet_0
(let ((module-uses_0
(hash-ref
phase-to-link-modules_0
phase-level_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (mis_0
is_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((mu_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((temp49_0
(phase+
(phase-
phase-level_0
(module-use-phase
mu_0))
phase-shift_0)))
(namespace-module-use->module+linklet-instances.1
temp49_0
original-self_0
self_0
ns_2
mu_0)))
(case-lambda
((mis43_0
is44_0)
(values
(cons
mis43_0
mis_0)
(cons
is44_0
is_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((mis_1
is_1)
(values
mis_1
is_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((mis_1
is_1)
(for-loop_0
mis_1
is_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
mis_0
is_0)))))))
(for-loop_0
null
null
module-uses_0))))
(case-lambda
((mis_0
is_0)
(let ((app_0
(reverse$1
mis_0)))
(values
app_0
(reverse$1
is_0))))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((import-module-instances_0
import-instances_0)
(begin
(let ((temp42_0
(hash-ref
phase-to-link-extra-inspectorsss_0
phase-level_0
#f)))
(check-require-access.1
2
phase-linklet_0
module-uses_0
import-module-instances_0
insp_0
extra-inspector_0
temp42_0))
(let ((module-body-instance-instance_0
(let ((temp50_0
(if (begin-unsafe
(eq?
phase-level_0
0))
(|#%name|
temp50
(lambda (name_0
val_0)
(begin
(error
'define-syntax
"should not happen at phase level 0"))))
(|#%name|
temp50
(lambda (name_0
val_0)
(begin
(namespace-set-transformer!
ns_2
(sub1
phase-level_0)
name_0
val_0)))))))
(make-module-body-instance-instance.1
temp50_0))))
(let ((instantiate-body_0
(|#%name|
instantiate-body
(lambda ()
(begin
(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
0))
(if (begin-unsafe
(eq?
phase-shift_0
0))
(instantiate-body_0)
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
ns_2)
(instantiate-body_0)))
(let ((ns-1_0
(namespace->namespace-at-phase
ns_2
(phase+
phase-shift_0
(sub1
phase-level_0)))))
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
ns_2)
(with-continuation-mark*
authentic
current-expand-context
(promise1.1
(lambda ()
(make-expand-context.1
#f
#f
#t
#f
#f
ns-1_0))
#f)
(with-continuation-mark*
authentic
current-module-code-inspector
insp_0
(instantiate-body_0))))))))))
(args
(raise-binding-result-arity-error
2
args)))))
(void))))
(if log-performance?
(end-performance-region)
(void)))))))
(let ((temp34_1
temp34_0)
(temp33_1
temp33_0)
(temp32_1
temp32_0)
(temp31_1
temp31_0)
(temp29_1
temp29_0)
(temp28_1
temp28_0)
(temp20_1
temp20_0))
(make-module.1
cross-phase-persistent?_0
temp33_1
temp31_1
temp35_0
language-info_0
max-phase_0
min-phase_0
#f
temp32_1
temp28_1
temp34_1
#f
provides_0
requires_0
original-self_0
temp20_1
temp29_1
supermodule-name3_0))))))))))))
(let ((declare-name_0
(substitute-module-declare-name
default-name_0)))
(begin
(if with-submodules?2_0
(|#%app|
declare-submodules_0
ns_1
pre-submodule-names_0
declare-name_0
#t)
(void))
(declare-module!.1
with-submodules?2_0
ns_1
m_0
declare-name_0)
(if with-submodules?2_0
(|#%app|
declare-submodules_0
ns_1
post-submodule-names_0
declare-name_0
#f)
(void))))))))))
(begin
(if cache-key_0
(module-cache-set!
cache-key_0
declare-this-module_0)
(void))
(declare-this-module_0
ns_0))))))))))))))))))))))))
(args (raise-binding-result-arity-error 4 args))))
(if log-performance? (end-performance-region) (void)))))))))
(define struct:instance-data
(make-record-type-descriptor*
'instance-data
#f
(|#%nongenerative-uid| instance-data)
#f
#f
2
0))
(define effect_2509
(struct-type-install-properties!
struct:instance-data
'instance-data
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'instance-data))
(define instance-data9.1
(|#%name|
instance-data
(record-constructor
(make-record-constructor-descriptor struct:instance-data #f #f))))
(define instance-data?_2770
(|#%name| instance-data? (record-predicate struct:instance-data)))
(define instance-data?
(|#%name|
instance-data?
(lambda (v)
(if (instance-data?_2770 v)
#t
($value
(if (impersonator? v)
(instance-data?_2770 (impersonator-val v))
#f))))))
(define instance-data-syntax-literals-instance_2650
(|#%name|
instance-data-syntax-literals-instance
(record-accessor struct:instance-data 0)))
(define instance-data-syntax-literals-instance
(|#%name|
instance-data-syntax-literals-instance
(lambda (s)
(if (instance-data?_2770 s)
(instance-data-syntax-literals-instance_2650 s)
($value
(impersonate-ref
instance-data-syntax-literals-instance_2650
struct:instance-data
0
s
'instance-data
'syntax-literals-instance))))))
(define instance-data-cache-key_2423
(|#%name| instance-data-cache-key (record-accessor struct:instance-data 1)))
(define instance-data-cache-key
(|#%name|
instance-data-cache-key
(lambda (s)
(if (instance-data?_2770 s)
(instance-data-cache-key_2423 s)
($value
(impersonate-ref
instance-data-cache-key_2423
struct:instance-data
1
s
'instance-data
'cache-key))))))
(define init-instance-data!
(lambda (data-box_0
cache-key_0
ns_0
syntax-literals-linklet_0
data-instance_0
syntax-literals-data-instance_0
phase-shift_0
original-self_0
self_0
bulk-binding-registry_0
insp_0
create-root-expand-context-from-module_0)
(begin
(if (not (load-on-demand-enabled))
(force-syntax-deserialize
syntax-literals-data-instance_0
bulk-binding-registry_0)
(void))
(let ((temp59_0
(lambda (name_0 val_0)
(error "shouldn't get here for the root-ctx linklet"))))
(let ((inst_0
(make-instance-instance.1
bulk-binding-registry_0
insp_0
ns_0
phase-shift_0
self_0
temp59_0)))
(let ((syntax-literals-instance_0
(if syntax-literals-linklet_0
(instantiate-linklet
syntax-literals-linklet_0
(list
deserialize-instance
data-instance_0
syntax-literals-data-instance_0
inst_0))
empty-syntax-literals-instance)))
(begin
(set-box!
data-box_0
(instance-data9.1 syntax-literals-instance_0 cache-key_0))
(let ((get-encoded-root-expand-ctx_0
(instance-variable-value
syntax-literals-instance_0
'get-encoded-root-expand-ctx)))
(if (eq? get-encoded-root-expand-ctx_0 'empty)
(let ((root-ctx_0
(promise1.1
(lambda ()
(shift-to-inside-root-context
(make-root-expand-context.1
#f
null
unsafe-undefined
unsafe-undefined
self_0)))
#f)))
(begin-unsafe
(set-box! (namespace-root-expand-ctx ns_0) root-ctx_0)))
(if (procedure? get-encoded-root-expand-ctx_0)
(let ((root-ctx_0
(promise1.1
(lambda ()
(shift-to-inside-root-context
(root-expand-context-decode-for-module
(|#%app| get-encoded-root-expand-ctx_0)
self_0)))
#f)))
(begin-unsafe
(set-box! (namespace-root-expand-ctx ns_0) root-ctx_0)))
(let ((root-ctx_0
(promise1.1
(lambda ()
(shift-to-inside-root-context
(|#%app|
create-root-expand-context-from-module_0
ns_0
phase-shift_0
original-self_0
self_0)))
#f)))
(begin-unsafe
(set-box!
(namespace-root-expand-ctx ns_0)
root-ctx_0)))))))))))))
(define force-syntax-deserialize
(lambda (syntax-literals-data-instance_0 bulk-binding-registry_0)
(if (let ((or-part_0
(eq?
syntax-literals-data-instance_0
empty-syntax-literals-data-instance)))
(if or-part_0
or-part_0
(eq?
syntax-literals-data-instance_0
empty-syntax-literals-instance/empty-namespace)))
(void)
(let ((deserialize-syntax_0
(instance-variable-value
syntax-literals-data-instance_0
deserialize-syntax-id)))
(if deserialize-syntax_0
(|#%app| deserialize-syntax_0 bulk-binding-registry_0)
(void))))))
(define compiled-module->dh+h
(lambda (c_0)
(let ((ld/h_0
(if (compiled-in-memory? c_0)
(compiled-in-memory-linklet-directory c_0)
c_0)))
(let ((dh_0
(if (linklet-directory?$1 ld/h_0)
(linklet-directory->hash$1 ld/h_0)
#f)))
(let ((h_0 (linklet-bundle->hash (if dh_0 (hash-ref dh_0 #f) ld/h_0))))
(values dh_0 h_0))))))
(define compiled-module->h
(lambda (c_0)
(call-with-values
(lambda () (compiled-module->dh+h c_0))
(case-lambda
((dh_0 h_0) h_0)
(args (raise-binding-result-arity-error 2 args))))))
(define compiled-module->dh+h+data-instance+declaration-instance
(lambda (c_0)
(call-with-values
(lambda () (compiled-module->dh+h c_0))
(case-lambda
((dh_0 h_0)
(let ((data-instance_0
(if (compiled-in-memory? c_0)
(make-data-instance-from-compiled-in-memory c_0)
(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)
(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
(lambda (c_0)
(call-with-values
(lambda () (compiled-module->dh+h+data-instance+declaration-instance c_0))
(case-lambda
((dh_0 h_0 data-instance_0 declaration-instance_0)
declaration-instance_0)
(args (raise-binding-result-arity-error 4 args))))))
(define compiled-module->h+declaration-instance
(lambda (c_0)
(call-with-values
(lambda () (compiled-module->dh+h+data-instance+declaration-instance c_0))
(case-lambda
((dh_0 h_0 data-instance_0 declaration-instance_0)
(values h_0 declaration-instance_0))
(args (raise-binding-result-arity-error 4 args))))))
(define make-data-instance-from-compiled-in-memory
(lambda (cim_0)
(make-instance
'data
#f
'constant
mpi-vector-id
(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)))))))
(define make-syntax-literal-data-instance-from-compiled-in-memory
(lambda (cim_0)
(make-instance
'syntax-literal-data
#f
#f
deserialize-syntax-id
void
deserialized-syntax-vector-id
(compiled-in-memory-syntax-literals cim_0))))
(define empty-syntax-literals-instance/empty-namespace
(make-instance
'empty-stx/empty-ns
#f
'constant
get-syntax-literal!-id
(lambda (pos_0) #f)
'get-encoded-root-expand-ctx
'empty))
(define get-all-variables
(lambda (phases-h_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value phases-h_0 i_0))
(case-lambda
((phase_0 linklet_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(linklet-export-variables linklet_0)))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (hash-iterate-next phases-h_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2725 (hash-iterate-first phases-h_0))))))
(define eval-linklet*
(lambda (l_0) (eval-linklet (force-compile-linklet l_0))))
(define check-provides-verbosity
(lambda (who_0 verbosity_0)
(if (let ((or-part_0 (not verbosity_0)))
(if or-part_0 or-part_0 (eq? verbosity_0 'defined-names)))
(void)
(raise-argument-error who_0 "(or/c #f 'defined-names)" verbosity_0))))
(define provides->api-provides
(lambda (provides_0 self_0 verbosity_0)
(let ((defined-names?_0 (eq? verbosity_0 'defined-names)))
(let ((extract_0
(|#%name|
extract
(lambda (ok?_0)
(begin
(let ((result-l_0
(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
provides_0
i_0))
(case-lambda
((phase_0 at-phase_0)
(let ((fold-var_1
(let ((l_0
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
at-phase_0
i_1))
(case-lambda
((sym_0
b/p_0)
(let ((fold-var_2
(if (|#%app|
ok?_0
b/p_0)
(let ((fold-var_2
(cons
(let ((b_0
(provided-as-binding
b/p_0)))
(let ((app_0
(if (eq?
self_0
(module-binding-module
b_0))
null
(reverse$1
(let ((lst_0
(cons
b_0
(module-binding-extra-nominal-bindings
b_0))))
(begin
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (fold-var_2
lst_1)
(begin
(if (pair?
lst_1)
(let ((b_1
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_3
(let ((fold-var_3
(cons
(if (if (eqv?
(module-binding-nominal-phase
b_1)
phase_0)
(eq?
(module-binding-nominal-sym
b_1)
sym_0)
#f)
(module-binding-nominal-module
b_1)
(let ((app_0
(module-binding-nominal-module
b_1)))
(let ((app_1
(module-binding-phase
b_1)))
(let ((app_2
(module-binding-nominal-sym
b_1)))
(list
app_0
app_1
app_2
(module-binding-nominal-phase
b_1))))))
fold-var_2)))
(values
fold-var_3))))
(for-loop_2
fold-var_3
rest_0))))
fold-var_2))))))
(for-loop_2
null
lst_0))))))))
(list*
sym_0
app_0
(if defined-names?_0
(list
(module-binding-sym
b_0))
null))))
fold-var_1)))
(values
fold-var_2))
fold-var_1)))
(for-loop_1
fold-var_2
(hash-iterate-next
at-phase_0
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
fold-var_1))))))
(for-loop_1
null
(hash-iterate-first
at-phase_0)))))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1)
(begin
(let ((fold-var_2
(if (null?
l_0)
fold-var_1
(let ((fold-var_2
(cons
(cons
phase_0
(sort.1
#f
car
l_0
symbol<?))
fold-var_1)))
(values
fold-var_2)))))
fold-var_2))))))
(for-loop_1
fold-var_0))))))
(for-loop_0
fold-var_1
(hash-iterate-next
provides_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
fold-var_0))))))
(for-loop_0
null
(hash-iterate-first provides_0)))))))
(sort.1 #f car result-l_0 phase<?)))))))
(let ((app_0
(extract_0
(lambda (b/p_0) (not (provided-as-transformer? b/p_0))))))
(values app_0 (extract_0 provided-as-transformer?)))))))
(define variables->api-nonprovides
(lambda (provides_0 all-vars_0)
(let ((result-l_0
(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 all-vars_0 i_0))
(case-lambda
((phase_0 vars_0)
(let ((fold-var_1
(let ((l_0
(let ((syms_0
(hash-ref
provides_0
phase_0
hash2610)))
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1 lst_0)
(begin
(if (pair? lst_0)
(let ((var-sym_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_2
(if (hash-ref
syms_0
var-sym_0
#f)
fold-var_1
(let ((fold-var_2
(cons
var-sym_0
fold-var_1)))
(values
fold-var_2)))))
(for-loop_1
fold-var_2
rest_0))))
fold-var_1))))))
(for-loop_1 null vars_0)))))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1)
(begin
(let ((fold-var_2
(if (null? l_0)
fold-var_1
(let ((fold-var_2
(cons
(cons
phase_0
(sort.1
#f
#f
l_0
symbol<?))
fold-var_1)))
(values
fold-var_2)))))
fold-var_2))))))
(for-loop_1 fold-var_0))))))
(for-loop_0
fold-var_1
(hash-iterate-next all-vars_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
fold-var_0))))))
(for-loop_0 null (hash-iterate-first all-vars_0)))))))
(sort.1 #f car result-l_0 phase<?))))
(define 1/compiled-expression?
(|#%name|
compiled-expression?
(lambda (c_0)
(begin
(let ((or-part_0 (compiled-in-memory? c_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (linklet-directory?$1 c_0)))
(if or-part_1 or-part_1 (linklet-bundle? c_0)))))))))
(define 1/compiled-module-expression?
(|#%name|
compiled-module-expression?
(lambda (c_0)
(begin
(let ((ld_0 (compiled->linklet-directory-or-bundle c_0)))
(let ((or-part_0
(if (linklet-directory?$1 ld_0)
(if (let ((b_0
(hash-ref
(linklet-directory->hash$1 ld_0)
#f
#f)))
(if b_0
(hash-ref (linklet-bundle->hash b_0) 'decl #f)
#f))
#t
#f)
#f)))
(if or-part_0
or-part_0
(if (linklet-bundle? ld_0)
(if (hash-ref (linklet-bundle->hash ld_0) 'decl #f) #t #f)
#f))))))))
(define compiled->linklet-directory-or-bundle
(lambda (c_0)
(if (compiled-in-memory? c_0)
(compiled-in-memory-linklet-directory c_0)
c_0)))
(define normalize-to-linklet-directory
(lambda (c_0)
(if (linklet-directory?$1 (compiled->linklet-directory-or-bundle c_0))
c_0
(if (linklet-bundle? c_0)
(hash->linklet-directory (hasheq #f c_0))
(if (compiled-in-memory? c_0)
(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))))))))))))))
(raise-argument-error 'struct-copy "compiled-in-memory?" c_0))))))
(define 1/module-compiled-name
(|#%name|
module-compiled-name
(case-lambda
((c_0)
(begin
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-name
"compiled-module-expression?"
c_0))
(module-compiled-current-name c_0))))
((c_0 name_0)
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-name
"compiled-module-expression?"
c_0))
(begin
(if (let ((or-part_0 (symbol? name_0)))
(if or-part_0
or-part_0
(if (pair? name_0)
(if (list? name_0) (andmap_2344 symbol? name_0) #f)
#f)))
(void)
(raise-argument-error
'module-compiled-name
"(or/c symbol? (cons/c symbol? (non-empty-listof symbol?)))"
name_0))
(call-with-values
(lambda ()
(if (symbol? name_0)
(values name_0 null)
(let ((r_0 (reverse$1 name_0)))
(let ((app_0 (car r_0)))
(values app_0 (reverse$1 (cdr r_0)))))))
(case-lambda
((i-name_0 prefix_0) (change-module-name c_0 i-name_0 prefix_0))
(args (raise-binding-result-arity-error 2 args))))))))))
(define module-compiled-current-name
(lambda (c_0)
(let ((ld_0 (compiled->linklet-directory-or-bundle c_0)))
(let ((b_0
(if (linklet-bundle? ld_0)
ld_0
(hash-ref (linklet-directory->hash$1 ld_0) #f))))
(hash-ref (linklet-bundle->hash b_0) 'name)))))
(define module-compiled-immediate-name
(lambda (c_0)
(let ((n_0 (module-compiled-current-name c_0)))
(if (pair? n_0) (car (reverse$1 n_0)) n_0))))
(define change-module-name
(lambda (c_0 name_0 prefix_0)
(let ((full-name_0
(if (null? prefix_0) name_0 (append prefix_0 (list name_0)))))
(let ((next-prefix_0 (if (null? prefix_0) (list name_0) full-name_0)))
(let ((recur_0
(|#%name|
recur
(lambda (sub-c_0 name_1)
(begin
(if (let ((app_0 (module-compiled-current-name sub-c_0)))
(equal? app_0 (append next-prefix_0 (list name_1))))
sub-c_0
(change-module-name sub-c_0 name_1 next-prefix_0)))))))
(if (compiled-in-memory? c_0)
(let ((change-submodule-name_0
(|#%name|
change-submodule-name
(lambda (sub-c_0)
(begin
(recur_0
sub-c_0
(module-compiled-immediate-name sub-c_0)))))))
(let ((pre-compiled-in-memorys_0
(map_1346
change-submodule-name_0
(compiled-in-memory-pre-compiled-in-memorys c_0))))
(let ((post-compiled-in-memorys_0
(map_1346
change-submodule-name_0
(compiled-in-memory-post-compiled-in-memorys c_0))))
(if (compiled-in-memory? c_0)
(let ((linklet-directory9_0
(let ((temp10_0
(update-one-name
(let ((ld_0
(compiled->linklet-directory-or-bundle
c_0)))
(if (linklet-bundle? ld_0)
ld_0
(hash-ref
(linklet-directory->hash$1 ld_0)
#f)))
full-name_0)))
(let ((temp11_0 (symbol? full-name_0)))
(let ((temp12_0
(append
pre-compiled-in-memorys_0
post-compiled-in-memorys_0)))
(let ((temp11_1 temp11_0) (temp10_1 temp10_0))
(rebuild-linklet-directory.1
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))))))))))))
(raise-argument-error
'struct-copy
"compiled-in-memory?"
c_0)))))
(if (linklet-directory?$1 c_0)
(hash->linklet-directory
(let ((ht_0 (linklet-directory->hash$1 c_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((key_0 val_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
key_0
(if (not key_0)
(update-one-name
val_0
full-name_0)
(recur_0 val_0 key_0))))
(case-lambda
((key_1 val_1)
(hash-set
table_0
key_1
val_1))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next ht_0 i_0))))
(args
(raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2610 (hash-iterate-first ht_0))))))
(update-one-name c_0 full-name_0))))))))
(define update-one-name
(lambda (lb_0 name_0)
(hash->linklet-bundle
(hash-set (linklet-bundle->hash lb_0) 'name name_0))))
(define rebuild-linklet-directory.1
(|#%name|
rebuild-linklet-directory
(lambda (bundle-ok?1_0 main3_0 submods4_0)
(begin
(if (if (null? submods4_0) bundle-ok?1_0 #f)
main3_0
(hash->linklet-directory
(hash-set
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_0 lst_0)
(begin
(if (pair? lst_0)
(let ((submod_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((ht_1
(let ((ht_1
(let ((name_0
(module-compiled-immediate-name
submod_0)))
(if (hash-ref ht_0 name_0 #f)
(raise-arguments-error
'module-compiled-submodules
"change would result in duplicate submodule name"
"name"
name_0)
(hash-set
ht_0
name_0
(compiled->linklet-directory-or-bundle
submod_0))))))
(values ht_1))))
(for-loop_0 ht_1 rest_0))))
ht_0))))))
(for-loop_0 hash2610 submods4_0)))
#f
main3_0)))))))
(define 1/module-compiled-submodules
(|#%name|
module-compiled-submodules
(case-lambda
((c_0 non-star?_0)
(begin
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-submodules
"compiled-module-expression?"
c_0))
(if (compiled-in-memory? c_0)
(if non-star?_0
(compiled-in-memory-pre-compiled-in-memorys c_0)
(compiled-in-memory-post-compiled-in-memorys c_0))
(if (linklet-directory?$1 c_0)
(let ((ht_0 (linklet-directory->hash$1 c_0)))
(let ((bh_0 (linklet-bundle->hash (hash-ref ht_0 #f))))
(let ((names_0
(hash-ref bh_0 (if non-star?_0 'pre 'post) null)))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((name_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(hash-ref ht_0 name_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null names_0)))))))
null)))))
((c_0 non-star?_0 submods_0)
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-submodules
"compiled-module-expression?"
c_0))
(if (if (list? submods_0)
(andmap_2344 1/compiled-module-expression? submods_0)
#f)
(void)
(raise-argument-error
'module-compiled-submodules
"(listof compiled-module-expression?)"
submods_0))
(if (if (null? submods_0)
(let ((or-part_0
(linklet-bundle?
(compiled->linklet-directory-or-bundle c_0))))
(if or-part_0
or-part_0
(if (compiled-in-memory? c_0)
(null?
(if non-star?_0
(compiled-in-memory-pre-compiled-in-memorys c_0)
(compiled-in-memory-post-compiled-in-memorys c_0)))
#f)))
#f)
c_0
(if (if (compiled-in-memory? c_0)
(andmap_2344 compiled-in-memory? submods_0)
#f)
(let ((pre-compiled-in-memorys_0
(if non-star?_0
submods_0
(compiled-in-memory-pre-compiled-in-memorys c_0))))
(let ((post-compiled-in-memorys_0
(if non-star?_0
(compiled-in-memory-post-compiled-in-memorys c_0)
submods_0)))
(let ((n-c_0 (normalize-to-linklet-directory c_0)))
(fixup-submodule-names
(if (compiled-in-memory? n-c_0)
(let ((linklet-directory4_0
(let ((temp5_0
(reset-submodule-names
(hash-ref
(linklet-directory->hash$1
(compiled->linklet-directory-or-bundle
n-c_0))
#f)
non-star?_0
submods_0)))
(let ((temp6_0
(symbol?
(module-compiled-current-name c_0))))
(let ((temp7_0
(append
pre-compiled-in-memorys_0
post-compiled-in-memorys_0)))
(let ((temp6_1 temp6_0) (temp5_1 temp5_0))
(rebuild-linklet-directory.1
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))))))))))))
(raise-argument-error
'struct-copy
"compiled-in-memory?"
n-c_0))))))
(let ((n-c_0 (normalize-to-linklet-directory c_0)))
(fixup-submodule-names
(let ((temp8_0
(reset-submodule-names
(hash-ref
(linklet-directory->hash$1
(compiled->linklet-directory-or-bundle n-c_0))
#f)
non-star?_0
submods_0)))
(let ((temp9_0
(map_1346
compiled->linklet-directory-or-bundle
(let ((app_0
(if non-star?_0
submods_0
(1/module-compiled-submodules c_0 #t))))
(append
app_0
(if non-star?_0
(1/module-compiled-submodules c_0 #f)
submods_0))))))
(let ((temp8_1 temp8_0))
(rebuild-linklet-directory.1
#f
temp8_1
temp9_0)))))))))))))
(define fixup-submodule-names
(lambda (c_0) (1/module-compiled-name c_0 (1/module-compiled-name c_0))))
(define reset-submodule-names
(lambda (b_0 pre?_0 submods_0)
(hash->linklet-bundle
(let ((app_0 (linklet-bundle->hash b_0)))
(let ((app_1 (if pre?_0 'pre 'post)))
(hash-set
app_0
app_1
(let ((temp10_0 (map_1346 module-compiled-immediate-name submods_0)))
(sort.1 #f #f temp10_0 symbol<?))))))))
(define 1/module-compiled-language-info
(|#%name|
module-compiled-language-info
(lambda (c_0)
(begin
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-language-info
"compiled-module-expression?"
c_0))
(let ((h_0 (compiled-module->h c_0)))
(hash-ref h_0 'language-info #f)))))))
(define 1/module-compiled-imports
(|#%name|
module-compiled-imports
(lambda (c_0)
(begin
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-imports
"compiled-module-expression?"
c_0))
(let ((inst_0 (compiled-module->declaration-instance c_0)))
(instance-variable-value inst_0 'requires)))))))
(define 1/module-compiled-exports
(let ((module-compiled-exports_0
(|#%name|
module-compiled-exports
(lambda (c2_0 verbosity1_0)
(begin
(begin
(if (1/compiled-module-expression? c2_0)
(void)
(raise-argument-error
'module-compiled-exports
"compiled-module-expression?"
c2_0))
(begin
(check-provides-verbosity
'module-compiled-exports
verbosity1_0)
(let ((inst_0 (compiled-module->declaration-instance c2_0)))
(let ((app_0 (instance-variable-value inst_0 'provides)))
(provides->api-provides
app_0
(instance-variable-value inst_0 'self-mpi)
verbosity1_0))))))))))
(|#%name|
module-compiled-exports
(case-lambda
((c_0) (begin (module-compiled-exports_0 c_0 #f)))
((c_0 verbosity1_0) (module-compiled-exports_0 c_0 verbosity1_0))))))
(define 1/module-compiled-indirect-exports
(|#%name|
module-compiled-indirect-exports
(lambda (c_0)
(begin
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-indirect-exports
"compiled-module-expression?"
c_0))
(call-with-values
(lambda () (compiled-module->h+declaration-instance c_0))
(case-lambda
((h_0 inst_0)
(let ((min-phase_0 (hash-ref h_0 'min-phase 0)))
(let ((max-phase_0 (hash-ref h_0 'max-phase 0)))
(let ((app_0 (instance-variable-value inst_0 'provides)))
(variables->api-nonprovides
app_0
(let ((end_0 (add1 max-phase_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 pos_0)
(begin
(if (< pos_0 end_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((linklet_0
(hash-ref
h_0
pos_0
#f)))
(values
pos_0
(if linklet_0
(linklet-export-variables
linklet_0)
null))))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (+ pos_0 1)))
table_0))))))
(for-loop_0 hash2725 min-phase_0)))))))))
(args (raise-binding-result-arity-error 2 args)))))))))
(define 1/module-compiled-cross-phase-persistent?
(|#%name|
module-compiled-cross-phase-persistent?
(lambda (c_0)
(begin
(begin
(if (1/compiled-module-expression? c_0)
(void)
(raise-argument-error
'module-compiled-cross-phase-persistent?
"compiled-module-expression?"
c_0))
(let ((h_0 (compiled-module->h c_0)))
(hash-ref h_0 'cross-phase-persistent? #f)))))))
(define compile-module.1
(|#%name|
compile-module
(lambda (force-linklet-directory?1_0
modules-being-compiled4_0
need-compiled-submodule-rename?5_0
serializable?2_0
to-correlated-linklet?3_0
p11_0
cctx12_0)
(begin
(let ((modules-being-compiled_0
(if (eq? modules-being-compiled4_0 unsafe-undefined)
(make-hasheq)
modules-being-compiled4_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
(let ((app_0
(if (list? parent-full-name_1)
parent-full-name_1
(list parent-full-name_1))))
(append app_0 (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 symbol<?))))
(let ((post-submodules_0
(let ((temp36_0 (get-submodules_0 #t)))
(sort.1 #f car temp36_0 symbol<?))))
(let ((c1_0 (parsed-module-compiled-module p11_0)))
(if c1_0
(call-with-values
(lambda ()
(if (symbol? full-module-name_0)
(values full-module-name_0 null)
(let ((r_0 (reverse$1 full-module-name_0)))
(let ((app_0 (car r_0)))
(values app_0 (reverse$1 (cdr r_0)))))))
(case-lambda
((name_0 prefix_0)
(let ((m_0
(change-module-name c1_0 name_0 prefix_0)))
(let ((app_0
(1/module-compiled-submodules
m_0
#t
(map_1346 cdr pre-submodules_0))))
(1/module-compiled-submodules
app_0
#f
(map_1346 cdr post-submodules_0)))))
(args (raise-binding-result-arity-error 2 args))))
(compile-module-from-parsed.1
force-linklet-directory?1_0
full-module-name_0
modules-being-compiled_0
need-compiled-submodule-rename?5_0
post-submodules_0
pre-submodules_0
serializable?2_0
to-correlated-linklet?3_0
p11_0
cctx12_0))))))))))))))
(define compile-module-from-parsed.1
(|#%name|
compile-module-from-parsed
(lambda (force-linklet-directory?15_0
full-module-name14_0
modules-being-compiled18_0
need-compiled-submodule-rename?21_0
post-submodules20_0
pre-submodules19_0
serializable?16_0
to-correlated-linklet?17_0
p30_0
cctx31_0)
(begin
(begin
(if log-performance?
(start-performance-region 'compile 'module)
(void))
(begin0
(let ((enclosing-self_0 (compile-context-module-self cctx31_0)))
(let ((self_0 (parsed-module-self p30_0)))
(let ((requires_0 (parsed-module-requires p30_0)))
(let ((provides_0 (parsed-module-provides p30_0)))
(let ((encoded-root-expand-ctx-box_0
(box (parsed-module-encoded-root-ctx p30_0))))
(let ((body-context-simple?_0
(parsed-module-root-ctx-simple? p30_0)))
(let ((language-info_0
(filter-language-info
(syntax-property$1
(parsed-s p30_0)
'module-language))))
(let ((bodys_0 (parsed-module-body p30_0)))
(let ((empty-result-for-module->namespace?_0 #f))
(let ((mpis_0 (make-module-path-index-table)))
(let ((body-cctx_0
(if (compile-context? cctx31_0)
(compile-context1.1
(compile-context-namespace cctx31_0)
0
self_0
self_0
full-module-name14_0
#t
(compile-context-header cctx31_0))
(raise-argument-error
'struct-copy
"compile-context?"
cctx31_0))))
(let ((cross-phase-persistent?_0 #f))
(let ((unsafe?-box_0 (box #f)))
(let ((side-effects_0 (make-hasheqv)))
(let ((check-side-effects!_0
(|#%name|
check-side-effects!
(lambda (e_0
expected-results_0
phase_0
required-reference?_0)
(begin
(if (hash-ref
side-effects_0
phase_0
#f)
(void)
(if (any-side-effects?.1
hash2610
hash2610
required-reference?_0
e_0
expected-results_0)
(hash-set!
side-effects_0
phase_0
#t)
(void))))))))
(begin
(if (if need-compiled-submodule-rename?21_0
modules-being-compiled18_0
#f)
(begin
(if (null? post-submodules20_0)
(void)
(error
"internal error: have post submodules, but not already compiled"))
(register-compiled-submodules
modules-being-compiled18_0
pre-submodules19_0
self_0))
(void))
(call-with-values
(lambda ()
(let ((temp60_0
(list
(list
get-syntax-literal!-id)
(list
set-transformer!-id))))
(let ((temp61_0
(list
empty-syntax-literals-instance
empty-module-body-instance)))
(let ((temp62_0 '((void))))
(let ((temp63_0 '(0)))
(let ((temp67_0
(lambda (body_0
cctx_0)
(if (|parsed-#%declare?|
body_0)
(call-with-values
(lambda ()
(let ((s_0
(parsed-s
body_0)))
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1
s_0)
(syntax-e$1
s_0)
s_0)))
(if (pair?
s_1)
(let ((_0
(let ((s_2
(car
s_1)))
s_2)))
(let ((kw76_0
(let ((s_2
(cdr
s_1)))
(let ((s_3
(if (syntax?$1
s_2)
(syntax-e$1
s_2)
s_2)))
(let ((flat-s_0
(to-syntax-list.1
s_3)))
(if (not
flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
s_0)
flat-s_0))))))
(let ((_1
_0))
(values
_1
kw76_0))))
(raise-syntax-error$1
#f
"bad syntax"
s_0))))
(case-lambda
((_0
kw74_0)
(values
#t
_0
kw74_0))
(args
(raise-binding-result-arity-error
2
args))))))
(case-lambda
((ok?_0
_0
kw74_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 (eq?
(syntax-e$1
kw_0)
kw2208)
(set! cross-phase-persistent?_0
#t)
(void))
(if (eq?
(syntax-e$1
kw_0)
kw2910)
(begin
(set! empty-result-for-module->namespace?_0
#t)
(set-box!
encoded-root-expand-ctx-box_0
#f))
(void))
(if (eq?
(syntax-e$1
kw_0)
kw2838)
(set-box!
unsafe?-box_0
#t)
(void)))
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
kw74_0)))
(void)
#f))
(args
(raise-binding-result-arity-error
3
args))))
#f))))
(let ((temp68_0
(lambda (mod-name_0
phase_0)
(let ((ht_0
(if modules-being-compiled18_0
(hash-ref
modules-being-compiled18_0
mod-name_0
#f)
#f)))
(if ht_0
(hash-ref
ht_0
phase_0
#f)
#f)))))
(compile-forms.1
temp61_0
temp60_0
temp62_0
check-side-effects!_0
void
encoded-root-expand-ctx-box_0
temp63_0
temp68_0
#t
#t
temp67_0
body-context-simple?_0
serializable?16_0
to-correlated-linklet?17_0
unsafe?-box_0
bodys_0
body-cctx_0
mpis_0))))))))
(case-lambda
((body-linklets_0
min-phase_0
max-phase_0
phase-to-link-module-uses_0
phase-to-link-module-uses-expr_0
phase-to-link-extra-inspectorsss_0
syntax-literals_0
root-ctx-pos_0)
(begin
(if modules-being-compiled18_0
(let ((app_0
(1/module-path-index-resolve
self_0)))
(hash-set!
modules-being-compiled18_0
app_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
body-linklets_0
i_0))
(case-lambda
((phase_0
linklet_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(let ((app_1
(hash-ref
phase-to-link-module-uses_0
phase_0
#f)))
(module-linklet-info2.1
linklet_0
app_1
self_0
#f
#f
(if phase-to-link-extra-inspectorsss_0
(hash-ref
phase-to-link-extra-inspectorsss_0
phase_0
#f)
#f)))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
(hash-iterate-next
body-linklets_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2610
(hash-iterate-first
body-linklets_0))))))
(void))
(let ((declaration-linklet_0
(if serializable?16_0
(let ((s_0
(generate-module-declaration-linklet
mpis_0
self_0
requires_0
provides_0
phase-to-link-module-uses-expr_0)))
(if to-correlated-linklet?17_0
(begin-unsafe
(correlated-linklet1.1
s_0
'decl
#f))
(begin
(if log-performance?
(start-performance-region
'compile
'module
'linklet)
(void))
(begin0
(compile-linklet
s_0
'decl)
(if log-performance?
(end-performance-region)
(void))))))
#f)))
(let ((syntax-literals-linklet_0
(if (not
(begin-unsafe
(null?
(syntax-literals-stxes
syntax-literals_0))))
(let ((s_0
(let ((app_0
(let ((app_0
(list
mpi-vector-id)))
(list
deserialize-imports
app_0
(list*
deserialized-syntax-vector-id
(if serializable?16_0
(list
deserialize-syntax-id)
'()))
instance-imports))))
(let ((app_1
(list*
get-syntax-literal!-id
'(get-encoded-root-expand-ctx))))
(list*
'linklet
app_0
app_1
(let ((app_2
(let ((temp80_0
(not
serializable?16_0)))
(generate-lazy-syntax-literals!.1
temp80_0
syntax-literals_0
mpis_0
self_0))))
(qq-append
app_2
(list
(list
'define-values
'(get-encoded-root-expand-ctx)
(if root-ctx-pos_0
(list
'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
s_0
'syntax-literals
#f))
(begin
(if log-performance?
(start-performance-region
'compile
'module
'linklet)
(void))
(begin0
(call-with-values
(lambda ()
(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)
linklet_0)
(args
(raise-binding-result-arity-error
2
args))))
(if log-performance?
(end-performance-region)
(void))))))
#f)))
(let ((syntax-literals-data-linklet_0
(if serializable?16_0
(if (not
(begin-unsafe
(null?
(syntax-literals-stxes
syntax-literals_0))))
(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
(let ((app_2
(list
deserialized-syntax-vector-id)))
(list
'define-values
app_2
(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?
(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
(if serializable?16_0
(let ((s_0
(generate-module-data-linklet
mpis_0)))
(if to-correlated-linklet?17_0
(begin-unsafe
(correlated-linklet1.1
s_0
'data
#f))
(begin
(if log-performance?
(start-performance-region
'compile
'module
'linklet)
(void))
(begin0
(compile-linklet
s_0
'data)
(if log-performance?
(end-performance-region)
(void))))))
#f)))
(let ((bundle_0
(let ((bundle_0
(hash-set
body-linklets_0
'name
full-module-name14_0)))
(let ((bundle_1
(hash-set
bundle_0
'decl
(if declaration-linklet_0
declaration-linklet_0
'in-memory))))
(let ((bundle_2
(if data-linklet_0
(hash-set
bundle_1
'data
data-linklet_0)
bundle_1)))
(let ((bundle_3
(if syntax-literals-linklet_0
(hash-set
bundle_2
'stx
syntax-literals-linklet_0)
bundle_2)))
(let ((bundle_4
(if syntax-literals-data-linklet_0
(hash-set
bundle_3
'stx-data
syntax-literals-data-linklet_0)
bundle_3)))
(let ((bundle_5
(if (null?
pre-submodules19_0)
bundle_4
(hash-set
bundle_4
'pre
(map_1346
car
pre-submodules19_0)))))
(let ((bundle_6
(if (null?
post-submodules20_0)
bundle_5
(hash-set
bundle_5
'post
(map_1346
car
post-submodules20_0)))))
(let ((bundle_7
(if cross-phase-persistent?_0
(hash-set
bundle_6
'cross-phase-persistent?
#t)
bundle_6)))
(let ((bundle_8
(if language-info_0
(hash-set
bundle_7
'language-info
language-info_0)
bundle_7)))
(let ((bundle_9
(if (zero?
min-phase_0)
bundle_8
(hash-set
bundle_8
'min-phase
min-phase_0))))
(let ((bundle_10
(if (zero?
max-phase_0)
bundle_9
(hash-set
bundle_9
'max-phase
max-phase_0))))
(let ((bundle_11
(if (hash-count
side-effects_0)
(hash-set
bundle_10
'side-effects
(let ((temp81_0
(hash-keys
side-effects_0)))
(sort.1
#f
#f
temp81_0
<)))
bundle_10)))
(let ((bundle_12
(if empty-result-for-module->namespace?_0
(hash-set
bundle_11
'module->namespace
'empty)
bundle_11)))
(let ((bundle_13
(if (unbox
unsafe?-box_0)
(hash-set
bundle_12
'unsafe?
#t)
bundle_12)))
(hash->linklet-bundle
bundle_13)))))))))))))))))
(let ((ld_0
(if (if (null?
pre-submodules19_0)
(if (null?
post-submodules20_0)
(not
force-linklet-directory?15_0)
#f)
#f)
bundle_0
(let ((ht_0
(let ((lst_0
(append
pre-submodules19_0
post-submodules20_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((sm_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((ht_1
(let ((ht_1
(let ((app_0
(car
sm_0)))
(hash-set
ht_0
app_0
(compiled-in-memory-linklet-directory
(cdr
sm_0))))))
(values
ht_1))))
(for-loop_0
ht_1
rest_0))))
ht_0))))))
(for-loop_0
(hasheq
#f
bundle_0)
lst_0))))))
(hash->linklet-directory
ht_0)))))
(let ((app_0
(current-code-inspector)))
(let ((app_1
(mpis-as-vector
mpis_0)))
(let ((app_2
(syntax-literals-as-vector
syntax-literals_0)))
(let ((app_3
(map_1346
cdr
pre-submodules19_0)))
(compiled-in-memory1.1
ld_0
self_0
requires_0
provides_0
phase-to-link-module-uses_0
app_0
phase-to-link-extra-inspectorsss_0
app_1
app_2
app_3
(map_1346
cdr
post-submodules20_0)
#f
#f)))))))))))))
(args
(raise-binding-result-arity-error
8
args))))))))))))))))))))
(if log-performance? (end-performance-region) (void))))))))
(define update-submodule-names
(lambda (cim_0 name_0 full-module-name_0)
(change-module-name
cim_0
name_0
(if (symbol? full-module-name_0)
(list full-module-name_0)
(reverse$1 (cdr (reverse$1 full-module-name_0)))))))
(define register-compiled-submodules
(lambda (modules-being-compiled_0 pre-submodules_0 self_0)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((s_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(let ((name_0 (car s_0)))
(let ((cim_0 (cdr s_0)))
(let ((phase-to-link-module-uses_0
(compiled-in-memory-phase-to-link-module-uses
cim_0)))
(let ((ld_0
(compiled-in-memory-linklet-directory
cim_0)))
(let ((sm-self_0
(1/module-path-index-join
(list 'submod "." name_0)
self_0)))
(let ((phase-to-extra-inspectorsss_0
(compiled-in-memory-phase-to-link-extra-inspectorsss
cim_0)))
(let ((app_0
(1/module-path-index-resolve
sm-self_0)))
(hash-set!
modules-being-compiled_0
app_0
(let ((ht_0
(linklet-bundle->hash
(if (linklet-directory?$1 ld_0)
(hash-ref
(linklet-directory->hash$1
ld_0)
#f)
ld_0))))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
ht_0
i_0))
(case-lambda
((phase_0 linklet_0)
(let ((table_1
(if (number?
phase_0)
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(let ((app_1
(hash-ref
phase-to-link-module-uses_0
phase_0
#f)))
(let ((app_2
(compiled-in-memory-original-self
cim_0)))
(let ((app_3
(compiled-in-memory-compile-time-inspector
cim_0)))
(module-linklet-info2.1
linklet_0
app_1
app_2
#f
app_3
(if phase-to-extra-inspectorsss_0
(hash-ref
phase-to-extra-inspectorsss_0
phase_0
#f)
#f)))))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))
table_0)))
(for-loop_1
table_1
(hash-iterate-next
ht_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_1
hash2610
(hash-iterate-first
ht_0)))))))))))))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 pre-submodules_0)))
(void))))
(define filter-language-info
(lambda (li_0)
(if (vector? li_0)
(if (= 3 (vector-length li_0))
(if (1/module-path? (vector-ref li_0 0))
(if (symbol? (vector-ref li_0 1)) li_0 #f)
#f)
#f)
#f)))
(define 1/compiled-expression-recompile
(|#%name|
compiled-expression-recompile
(lambda (c_0)
(begin
(begin
(if (1/compiled-expression? c_0)
(void)
(raise-argument-error
'compiled-expression-recompile
"compiled-expression?"
c_0))
(let ((target-machine_0 (current-compile-target-machine)))
(if (not target-machine_0)
c_0
(if (let ((or-part_0 (linklet-bundle? c_0)))
(if or-part_0 or-part_0 (linklet-directory?$1 c_0)))
(let ((ns_0 (1/current-namespace)))
(let ((bundles_0
(extract-linklet-bundles c_0 '() hash2725)))
(let ((recompileds_0 (make-hash)))
(letrec*
((force-recompile-bundle_0
(|#%name|
force-recompile-bundle
(lambda (k_0)
(begin
(begin
(if (hash-ref recompileds_0 k_0 #f)
(void)
(begin
(hash-set! recompileds_0 k_0 'in-process)
(let ((b_0 (hash-ref bundles_0 k_0 #f)))
(begin
(if b_0
(void)
(raise-arguments-error
'compiled-expression-recompile
"cannot find submodule"
"submodule path"
k_0))
(hash-set!
recompileds_0
k_0
(recompile-bundle
b_0
force-recompile-bundle_0
ns_0
target-machine_0))))))
(hash-ref recompileds_0 k_0)))))))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((k_0
(hash-iterate-key bundles_0 i_0)))
(begin
(force-recompile-bundle_0 k_0)
(for-loop_0
(hash-iterate-next bundles_0 i_0))))
(values)))))))
(for-loop_0 (hash-iterate-first bundles_0))))
(void)
(replace-linklet-bundles c_0 '() recompileds_0))))))
(1/compiled-expression-recompile
(compiled-in-memory-linklet-directory c_0))))))))))
(define extract-linklet-bundles
(lambda (c_0 rev-path_0 accum_0)
(if (linklet-bundle? c_0)
(hash-set accum_0 (reverse$1 rev-path_0) c_0)
(if (linklet-directory?$1 c_0)
(let ((ht_0 (linklet-directory->hash$1 c_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (accum_1 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((accum_2
(let ((accum_2
(if (symbol? k_0)
(extract-linklet-bundles
v_0
(cons k_0 rev-path_0)
accum_1)
(if (not k_0)
(extract-linklet-bundles
v_0
rev-path_0
accum_1)
accum_1))))
(values accum_2))))
(for-loop_0 accum_2 (hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
accum_1))))))
(for-loop_0 accum_0 (hash-iterate-first ht_0)))))
accum_0))))
(define replace-linklet-bundles
(lambda (c_0 rev-path_0 recompileds_0)
(if (linklet-bundle? c_0)
(recompiled-bundle (hash-ref recompileds_0 (reverse$1 rev-path_0)))
(if (linklet-directory?$1 c_0)
(hash->linklet-directory
(let ((ht_0 (linklet-directory->hash$1 c_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(if (symbol? k_0)
(replace-linklet-bundles
v_0
(cons k_0 rev-path_0)
recompileds_0)
(if (not k_0)
(replace-linklet-bundles
v_0
rev-path_0
recompileds_0)
(void)))))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 (hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2610 (hash-iterate-first ht_0))))))
c_0))))
(define struct:recompiled
(make-record-type-descriptor*
'recompiled
#f
(|#%nongenerative-uid| recompiled)
#f
#f
3
0))
(define effect_2475
(struct-type-install-properties!
struct:recompiled
'recompiled
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'recompiled))
(define recompiled1.1
(|#%name|
recompiled
(record-constructor
(make-record-constructor-descriptor struct:recompiled #f #f))))
(define recompiled?
(|#%name| recompiled? (record-predicate struct:recompiled)))
(define recompiled-bundle
(|#%name| recompiled-bundle (record-accessor struct:recompiled 0)))
(define recompiled-phase-to-link-module-uses
(|#%name|
recompiled-phase-to-link-module-uses
(record-accessor struct:recompiled 1)))
(define recompiled-self
(|#%name| recompiled-self (record-accessor struct:recompiled 2)))
(define recompile-bundle
(lambda (b_0 get-submodule-recompiled_0 ns_0 target-machine_0)
(let ((orig-h_0 (linklet-bundle->hash b_0)))
(let ((h_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value orig-h_0 i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(if (if (not (exact-integer? k_0))
(correlated-linklet? v_0)
#f)
(values
k_0
(force-compile-linklet v_0))
(values k_0 v_0)))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next orig-h_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2610 (hash-iterate-first orig-h_0))))))
(let ((can-eval-compiled?_0
(eq? target-machine_0 (system-type 'target-machine))))
(let ((eval-metadata-linklet_0
(|#%name|
eval-metadata-linklet
(lambda (key_0)
(begin
(if can-eval-compiled?_0
(eval-linklet (hash-ref h_0 key_0))
(eval-correlated-linklet
(hash-ref orig-h_0 key_0))))))))
(let ((data-instance_0
(let ((app_0 (eval-metadata-linklet_0 'data)))
(instantiate-linklet app_0 (list deserialize-instance)))))
(let ((declaration-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
(lambda (key_0)
(begin
(instance-variable-value
declaration-instance_0
key_0))))))
(let ((mpis_0 (make-module-path-index-table)))
(begin
(call-with-values
(lambda ()
(let ((vec_0
(instance-variable-value
data-instance_0
mpi-vector-id)))
(begin
(check-vector vec_0)
(values vec_0 (unsafe-vector-length vec_0)))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (pos_0)
(begin
(if (unsafe-fx< pos_0 len_0)
(let ((mpi_0
(unsafe-vector-ref vec_0 pos_0)))
(begin
(add-module-path-index! mpis_0 mpi_0)
(for-loop_0 (unsafe-fx+ 1 pos_0))))
(values)))))))
(for-loop_0 0))))
(args (raise-binding-result-arity-error 2 args))))
(let ((self_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'self-mpi)))))
(let ((phase-to-link-modules_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'phase-to-link-modules)))))
(let ((unsafe?_0 (hash-ref orig-h_0 'unsafe? #f)))
(let ((find-submodule_0
(|#%name|
find-submodule
(lambda (mod-name_0 phase_0)
(begin
(let ((find-l_0
(1/resolved-module-path-name
mod-name_0)))
(let ((self-l_0
(1/resolved-module-path-name
(1/module-path-index-resolve
self_0))))
(let ((root-of_0
(|#%name|
root-of
(lambda (l_0)
(begin
(if (pair? l_0)
(car l_0)
l_0))))))
(if (let ((app_0
(root-of_0 find-l_0)))
(equal?
app_0
(root-of_0 self-l_0)))
(let ((r_0
(|#%app|
get-submodule-recompiled_0
(if (pair? find-l_0)
(cdr find-l_0)
'()))))
(begin
(if (eq? r_0 'in-process)
(raise-arguments-error
'compiled-expression-recompile
"cycle in linklet imports")
(void))
(let ((b_1
(recompiled-bundle
r_0)))
(let ((linklet_0
(let ((or-part_0
(hash-ref
(linklet-bundle->hash
b_1)
phase_0
#f)))
(if or-part_0
or-part_0
(raise-arguments-error
'compiled-expression-recompile
"cannot find submodule at phase"
"submodule"
mod-name_0
"phase"
phase_0)))))
(let ((app_0
(hash-ref
(recompiled-phase-to-link-module-uses
r_0)
phase_0
#f)))
(module-linklet-info2.1
linklet_0
app_0
(recompiled-self
r_0)
#f
(current-code-inspector)
#f))))))
#f)))))))))
(let ((body-linklets+module-use*s_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
h_0
i_0))
(case-lambda
((phase_0 body-linklet_0)
(let ((table_1
(if (exact-integer?
phase_0)
(let ((table_1
(call-with-values
(lambda ()
(let ((module-use*s_0
(module-uses-add-extra-inspectorsss
(hash-ref
phase-to-link-modules_0
phase_0)
#f)))
(call-with-values
(lambda ()
(let ((temp3_0
(if (correlated-linklet?
body-linklet_0)
(correlated-linklet-expr
body-linklet_0)
body-linklet_0)))
(let ((temp4_0
(if (correlated-linklet?
body-linklet_0)
compile-linklet
recompile-linklet)))
(let ((temp5_0
(list
(list
get-syntax-literal!-id)
(list
set-transformer!-id))))
(let ((temp6_0
(list
empty-syntax-literals-instance
empty-module-body-instance)))
(let ((temp5_1
temp5_0)
(temp4_1
temp4_0)
(temp3_1
temp3_0))
(compile-module-linklet.1
temp6_0
temp5_1
temp4_1
find-submodule_0
#t
#t
module-use*s_0
ns_0
#t
#t
unsafe?_0
temp3_1)))))))
(case-lambda
((linklet_0
new-module-use*s_0)
(values
phase_0
(cons
linklet_0
new-module-use*s_0)))
(args
(raise-binding-result-arity-error
2
args))))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))
table_0)))
(for-loop_0
table_1
(hash-iterate-next
h_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2725
(hash-iterate-first h_0))))))
(let ((h/new-body-linklets_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (h_1 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
body-linklets+module-use*s_0
i_0))
(case-lambda
((phase_0 l+mu*s_0)
(let ((h_2
(let ((h_2
(hash-set
h_1
phase_0
(car
l+mu*s_0))))
(values h_2))))
(for-loop_0
h_2
(hash-iterate-next
body-linklets+module-use*s_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
h_1))))))
(for-loop_0
h_0
(hash-iterate-first
body-linklets+module-use*s_0))))))
(let ((phase-to-link-module-uses_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
body-linklets+module-use*s_0
i_0))
(case-lambda
((phase_0 l+mu*s_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
phase_0
(module-uses-strip-extra-inspectorsss
(cdr
l+mu*s_0))))
(case-lambda
((key_0
val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_1))))
(for-loop_0
table_1
(hash-iterate-next
body-linklets+module-use*s_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2610
(hash-iterate-first
body-linklets+module-use*s_0))))))
(let ((phase-to-link-module-uses-expr_0
(serialize-phase-to-link-module-uses
phase-to-link-module-uses_0
mpis_0)))
(let ((data-linklet_0
(compile-linklet
(generate-module-data-linklet
mpis_0)
'data)))
(let ((declaration-linklet_0
(compile-linklet
(let ((app_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'requires)))))
(generate-module-declaration-linklet
mpis_0
self_0
app_0
(begin-unsafe
(begin
(instance-variable-value
declaration-instance_0
'provides)))
phase-to-link-module-uses-expr_0))
'decl)))
(let ((new-bundle_0
(hash->linklet-bundle
(let ((h_1
(hash-set
h/new-body-linklets_0
'data
data-linklet_0)))
(let ((h_2
(hash-set
h_1
'decl
declaration-linklet_0)))
h_2)))))
(recompiled1.1
new-bundle_0
phase-to-link-module-uses_0
self_0)))))))))))))))))))))))
(define create-compiled-in-memorys-using-shared-data
(lambda (tops_0 data-linklet_0 ns_0)
(let ((data-instance_0
(instantiate-linklet
data-linklet_0
(list
deserialize-instance
(let ((temp2_0 (namespace-phase ns_0)))
(let ((temp3_0 (namespace-mpi ns_0)))
(let ((temp4_0 (namespace-bulk-binding-registry ns_0)))
(let ((temp5_0 (current-code-inspector)))
(let ((temp4_1 temp4_0)
(temp3_1 temp3_0)
(temp2_1 temp2_0))
(make-eager-instance-instance.1
temp4_1
temp2_1
temp5_0
ns_0
temp3_1))))))))))
(let ((data_0
(|#%name|
data
(lambda (key_0)
(begin (instance-variable-value data-instance_0 key_0))))))
(let ((mpi-vector_0
(begin-unsafe
(begin
(instance-variable-value data-instance_0 mpi-vector-id)))))
(let ((mpi-vector-trees_0
(begin-unsafe
(begin
(instance-variable-value
data-instance_0
'mpi-vector-trees)))))
(let ((phase-to-link-modules-vector_0
(begin-unsafe
(begin
(instance-variable-value
data-instance_0
'phase-to-link-modules-vector)))))
(let ((phase-to-link-modules-trees_0
(begin-unsafe
(begin
(instance-variable-value
data-instance_0
'phase-to-link-modules-trees)))))
(let ((syntax-literals_0
(begin-unsafe
(begin
(instance-variable-value
data-instance_0
'syntax-literals)))))
(let ((syntax-literals-trees_0
(begin-unsafe
(begin
(instance-variable-value
data-instance_0
'syntax-literals-trees)))))
(let ((namespace-scopes_0 (extract-namespace-scopes ns_0)))
(letrec*
((construct-compiled-in-memory_0
(|#%name|
construct-compiled-in-memory
(lambda (ld_0
mpi-vector-tree_0
phase-to-link-modules-tree_0
syntax-literals-tree_0)
(begin
(let ((or-part_0 (linklet-bundle? ld_0)))
(let ((is-module?_0
(if or-part_0
or-part_0
(let ((b_0
(hash-ref
(linklet-directory->hash$1
ld_0)
#f
#f)))
(if b_0
(hash-ref
(linklet-bundle->hash b_0)
'decl
#f)
#f)))))
(let ((mpi-pos-vec_0
(vector-ref mpi-vector-tree_0 0)))
(let ((syntax-literals-spec_0
(vector-ref
syntax-literals-tree_0
0)))
(let ((pres_0
(if is-module?_0
(extract-submodules ld_0 'pre)
(compiled-top->compiled-tops
ld_0))))
(let ((posts_0
(if is-module?_0
(extract-submodules
ld_0
'post)
null)))
(let ((map-construct-compiled-in-memory_0
(|#%name|
map-construct-compiled-in-memory
(lambda (l_0 vec-pos_0)
(begin
(reverse$1
(let ((lst_0
(vector-ref
mpi-vector-tree_0
vec-pos_0)))
(let ((lst_1
(vector-ref
phase-to-link-modules-tree_0
vec-pos_0)))
(let ((lst_2
(vector-ref
syntax-literals-tree_0
vec-pos_0)))
(let ((lst_3
lst_1)
(lst_4
lst_0))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_5
lst_6
lst_7
lst_8)
(begin
(if (if (pair?
lst_5)
(if (pair?
lst_6)
(if (pair?
lst_7)
(pair?
lst_8)
#f)
#f)
#f)
(let ((sub-ld_0
(unsafe-car
lst_5)))
(let ((rest_0
(unsafe-cdr
lst_5)))
(let ((mpi-vector-tree_1
(unsafe-car
lst_6)))
(let ((rest_1
(unsafe-cdr
lst_6)))
(let ((phase-to-link-modules-tree_1
(unsafe-car
lst_7)))
(let ((rest_2
(unsafe-cdr
lst_7)))
(let ((syntax-literals-tree_1
(unsafe-car
lst_8)))
(let ((rest_3
(unsafe-cdr
lst_8)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(construct-compiled-in-memory_0
sub-ld_0
mpi-vector-tree_1
phase-to-link-modules-tree_1
syntax-literals-tree_1)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0
rest_1
rest_2
rest_3))))))))))
fold-var_0))))))
(for-loop_0
null
l_0
lst_4
lst_3
lst_2)))))))))))))
(let ((app_0
(vector-ref
phase-to-link-modules-vector_0
(vector-ref
phase-to-link-modules-tree_0
0))))
(let ((app_1
(let ((len_0
(vector-length
mpi-pos-vec_0)))
(begin
(if (exact-nonnegative-integer?
len_0)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_0))
(let ((v_0
(make-vector
len_0
0)))
(begin
(if (zero? len_0)
(void)
(call-with-values
(lambda ()
(begin
(check-vector
mpi-pos-vec_0)
(values
mpi-pos-vec_0
(unsafe-vector-length
mpi-pos-vec_0))))
(case-lambda
((vec_0 len_1)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0
pos_0)
(begin
(if (unsafe-fx<
pos_0
len_1)
(let ((pos_1
(unsafe-vector-ref
vec_0
pos_0)))
(let ((i_1
(let ((i_1
(begin
(unsafe-vector*-set!
v_0
i_0
(vector-ref
mpi-vector_0
pos_1))
(unsafe-fx+
1
i_0))))
(values
i_1))))
(if (if (not
(let ((x_0
(list
pos_1)))
(unsafe-fx=
i_1
len_0)))
#t
#f)
(for-loop_0
i_1
(unsafe-fx+
1
pos_0))
i_1)))
i_0))))))
(for-loop_0
0
0))))
(args
(raise-binding-result-arity-error
2
args)))))
v_0))))))
(let ((app_2
(let ((len_0
(cdr
syntax-literals-spec_0)))
(begin
(if (exact-nonnegative-integer?
len_0)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_0))
(let ((v_0
(make-vector
len_0
0)))
(begin
(if (zero?
len_0)
(void)
(let ((end_0
(cdr
syntax-literals-spec_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0
pos_0)
(begin
(if (<
pos_0
end_0)
(let ((i_1
(let ((i_1
(begin
(unsafe-vector*-set!
v_0
i_0
(if syntax-literals_0
(vector-ref
syntax-literals_0
(+
(car
syntax-literals-spec_0)
pos_0))
#f))
(unsafe-fx+
1
i_0))))
(values
i_1))))
(if (if (not
(let ((x_0
(list
pos_0)))
(unsafe-fx=
i_1
len_0)))
#t
#f)
(for-loop_0
i_1
(+
pos_0
1))
i_1))
i_0))))))
(for-loop_0
0
0)))))
v_0))))))
(let ((app_3
(map-construct-compiled-in-memory_0
pres_0
1)))
(compiled-in-memory1.1
ld_0
#f
#f
#f
app_0
#f
hash2589
app_1
app_2
app_3
(map-construct-compiled-in-memory_0
posts_0
2)
namespace-scopes_0
#f)))))))))))))))))
(map_1346
construct-compiled-in-memory_0
tops_0
mpi-vector-trees_0
phase-to-link-modules-trees_0
syntax-literals-trees_0)))))))))))))
(define extract-submodules
(lambda (ld_0 names-key_0)
(if (linklet-bundle? ld_0)
null
(let ((h_0 (linklet-directory->hash$1 ld_0)))
(let ((mod_0 (hash-ref h_0 #f #f)))
(begin
(if mod_0 (void) (error "missing main module"))
(let ((mh_0 (linklet-bundle->hash mod_0)))
(let ((names_0 (hash-ref mh_0 names-key_0 null)))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((name_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(hash-ref
h_0
name_0
(lambda ()
(error
"missing submodule declaration:"
name_0)))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null names_0))))))))))))
(define eval-single-top (lambda (c_0 ns_0) (eval-one-top.1 #t c_0 ns_0 #t)))
(define compiled-multiple-top?
(lambda (c_0)
(let ((ld_0
(if (compiled-in-memory? c_0)
(compiled-in-memory-linklet-directory c_0)
c_0)))
(if (linklet-directory?$1 ld_0)
(not (hash-ref (linklet-directory->hash$1 ld_0) #f #f))
#f))))
(define eval-top
(let ((eval-top_0
(|#%name|
eval-top
(lambda (c3_0 ns4_0 eval-compiled1_0 as-tail?2_0)
(begin
(let ((eval-compiled_0
(if (eq? eval-compiled1_0 unsafe-undefined)
eval-top
eval-compiled1_0)))
(if (compiled-multiple-top? c3_0)
(eval-multiple-tops c3_0 ns4_0 eval-compiled_0 as-tail?2_0)
(eval-one-top.1 #f c3_0 ns4_0 as-tail?2_0))))))))
(case-lambda
((c_0 ns_0) (eval-top_0 c_0 ns_0 unsafe-undefined #t))
((c_0 ns_0 eval-compiled_0 as-tail?2_0)
(eval-top_0 c_0 ns_0 eval-compiled_0 as-tail?2_0))
((c_0 ns_0 eval-compiled1_0) (eval-top_0 c_0 ns_0 eval-compiled1_0 #t)))))
(define eval-multiple-tops
(lambda (c_0 ns_0 eval-compiled_0 as-tail?_0)
(let ((eval-compiled-parts_0
(|#%name|
eval-compiled-parts
(lambda (l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? l_1)
void
(if (null? (cdr l_1))
(|#%app| eval-compiled_0 (car l_1) ns_0 as-tail?_0)
(begin
(|#%app| eval-compiled_0 (car l_1) ns_0 #f)
(loop_0 (cdr l_1))))))))))
(loop_0 l_0)))))))
(if (compiled-in-memory? c_0)
(eval-compiled-parts_0
(compiled-in-memory-pre-compiled-in-memorys c_0))
(let ((c1_0 (hash-ref (linklet-directory->hash$1 c_0) 'data #f)))
(if c1_0
(eval-compiled-parts_0
(let ((app_0 (compiled-top->compiled-tops c_0)))
(create-compiled-in-memorys-using-shared-data
app_0
(hash-ref
(linklet-bundle->hash
(hash-ref (linklet-directory->hash$1 c1_0) #f))
0)
ns_0)))
(eval-compiled-parts_0 (compiled-top->compiled-tops c_0))))))))
(define eval-one-top.1
(|#%name|
eval-one-top
(lambda (single-expression?5_0 c8_0 ns9_0 as-tail?7_0)
(begin
(begin
(if log-performance?
(start-performance-region
'eval
(if single-expression?5_0 'transformer 'top))
(void))
(begin0
(let ((ld_0
(if (compiled-in-memory? c8_0)
(compiled-in-memory-linklet-directory c8_0)
c8_0)))
(let ((h_0
(linklet-bundle->hash
(hash-ref (linklet-directory->hash$1 ld_0) #f))))
(let ((link-instance_0
(if (compiled-in-memory? c8_0)
(link-instance-from-compiled-in-memory
c8_0
(if (not single-expression?5_0) ns9_0 #f))
(let ((app_0
(force-compile-linklet (hash-ref h_0 'link))))
(instantiate-linklet
app_0
(list
deserialize-instance
(let ((temp18_0 (namespace-phase ns9_0)))
(let ((temp19_0 (namespace-mpi ns9_0)))
(let ((temp20_0
(namespace-bulk-binding-registry
ns9_0)))
(let ((temp21_0 (current-code-inspector)))
(let ((temp20_1 temp20_0)
(temp19_1 temp19_0)
(temp18_1 temp18_0))
(make-eager-instance-instance.1
temp20_1
temp18_1
temp21_0
ns9_0
temp19_1))))))))))))
(let ((orig-phase_0 (hash-ref h_0 'original-phase)))
(let ((max-phase_0 (hash-ref h_0 'max-phase)))
(let ((phase-shift_0
(phase- (namespace-phase ns9_0) orig-phase_0)))
(let ((extra-inspector_0
(if (compiled-in-memory? c8_0)
(compiled-in-memory-compile-time-inspector
c8_0)
#f)))
(let ((phase-to-link-extra-inspectorsss_0
(if (compiled-in-memory? c8_0)
(compiled-in-memory-phase-to-link-extra-inspectorsss
c8_0)
hash2589)))
(let ((phase-to-link-modules_0
(if (compiled-in-memory? c8_0)
(compiled-in-memory-phase-to-link-module-uses
c8_0)
(instance-variable-value
link-instance_0
'phase-to-link-modules))))
(let ((thunk_0
(let ((end_0 (sub1 orig-phase_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (prev-thunk_0 pos_0)
(begin
(if (> pos_0 end_0)
(let ((prev-thunk_1
(let ((prev-thunk_1
(begin
(|#%app|
prev-thunk_0
#f)
(let ((module-uses_0
(hash-ref
phase-to-link-modules_0
pos_0
null)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (mis_0
is_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((mu_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((temp26_0
(let ((app_0
(phase+
pos_0
phase-shift_0)))
(phase-
app_0
(module-use-phase
mu_0)))))
(namespace-module-use->module+linklet-instances.1
temp26_0
#f
#f
ns9_0
mu_0)))
(case-lambda
((mis22_0
is23_0)
(values
(cons
mis22_0
mis_0)
(cons
is23_0
is_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((mis_1
is_1)
(values
mis_1
is_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((mis_1
is_1)
(for-loop_1
mis_1
is_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
mis_0
is_0)))))))
(for-loop_1
null
null
module-uses_0))))
(case-lambda
((mis_0
is_0)
(let ((app_0
(reverse$1
mis_0)))
(values
app_0
(reverse$1
is_0))))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((import-module-instances_0
import-instances_0)
(let ((phase-ns_0
(namespace->namespace-at-phase
ns9_0
(phase+
pos_0
phase-shift_0))))
(let ((inst_0
(if single-expression?5_0
link-instance_0
(let ((temp29_0
(namespace-mpi
ns9_0)))
(let ((temp30_0
(namespace-inspector
ns9_0)))
(let ((temp31_0
(namespace-bulk-binding-registry
ns9_0)))
(let ((temp32_0
(lambda (name_0
val_0)
(namespace-set-transformer!
ns9_0
(phase+
(sub1
pos_0)
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)))))))))
(let ((linklet_0
(force-compile-linklet
(hash-ref
h_0
pos_0
#f))))
(if linklet_0
(begin
(let ((temp37_0
(current-code-inspector)))
(let ((temp39_0
(hash-ref
phase-to-link-extra-inspectorsss_0
pos_0
#f)))
(let ((temp37_1
temp37_0))
(check-require-access.1
3
linklet_0
module-uses_0
import-module-instances_0
temp37_1
extra-inspector_0
temp39_0))))
(let ((instantiate_0
(|#%name|
instantiate
(lambda (tail?_0)
(begin
(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
(phase-
(phase+
pos_0
phase-shift_0)
(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
0))
instantiate_0
(if single-expression?5_0
(|#%name|
prev-thunk
(lambda (tail?_0)
(begin
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
phase-ns_0)
(instantiate_0
tail?_0)))))
(let ((ns-1_0
(namespace->namespace-at-phase
phase-ns_0
(sub1
pos_0))))
(|#%name|
prev-thunk
(lambda (tail?_0)
(begin
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
phase-ns_0)
(with-continuation-mark*
authentic
current-expand-context
(make-expand-context.1
#f
#f
#f
#f
#f
ns-1_0)
(instantiate_0
tail?_0)))))))))))
void)))))
(args
(raise-binding-result-arity-error
2
args))))))))
(values
prev-thunk_1))))
(for-loop_0
prev-thunk_1
(+ pos_0 -1)))
prev-thunk_0))))))
(for-loop_0 void max-phase_0))))))
(|#%app| thunk_0 as-tail?7_0)))))))))))
(if log-performance? (end-performance-region) (void))))))))
(define link-instance-from-compiled-in-memory
(lambda (cim_0 to-ns_0)
(let ((orig-syntax-literals_0 (compiled-in-memory-syntax-literals cim_0)))
(let ((syntax-literals_0
(if (not to-ns_0)
orig-syntax-literals_0
(if (let ((app_0 (compiled-in-memory-namespace-scopes cim_0)))
(namespace-scopes=?
app_0
(extract-namespace-scopes to-ns_0)))
orig-syntax-literals_0
(let ((len_0 (vector-length orig-syntax-literals_0)))
(begin
(if (exact-nonnegative-integer? len_0)
(void)
(raise-argument-error
'for/vector
"exact-nonnegative-integer?"
len_0))
(let ((v_0 (make-vector len_0 0)))
(begin
(if (zero? len_0)
(void)
(call-with-values
(lambda ()
(begin
(check-vector orig-syntax-literals_0)
(values
orig-syntax-literals_0
(unsafe-vector-length
orig-syntax-literals_0))))
(case-lambda
((vec_0 len_1)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0 pos_0)
(begin
(if (unsafe-fx< pos_0 len_1)
(let ((s_0
(unsafe-vector-ref
vec_0
pos_0)))
(let ((i_1
(let ((i_1
(begin
(unsafe-vector*-set!
v_0
i_0
(swap-top-level-scopes
s_0
(compiled-in-memory-namespace-scopes
cim_0)
to-ns_0))
(unsafe-fx+
1
i_0))))
(values i_1))))
(if (if (not
(let ((x_0 (list s_0)))
(unsafe-fx=
i_1
len_0)))
#t
#f)
(for-loop_0
i_1
(unsafe-fx+ 1 pos_0))
i_1)))
i_0))))))
(for-loop_0 0 0))))
(args
(raise-binding-result-arity-error 2 args)))))
v_0))))))))
(make-instance
'link
#f
'constant
mpi-vector-id
(compiled-in-memory-mpis cim_0)
syntax-literals-id
syntax-literals_0)))))
(define not-available (gensym 'not-available))
(define get-not-available (lambda () not-available))
(define can-direct-eval?
(lambda (p_0 ns_0 self-mpi_0)
(if (parsed-app? p_0)
(if (can-direct-eval? (parsed-app-rator p_0) ns_0 self-mpi_0)
(let ((lst_0 (parsed-app-rands p_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((r_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((result_1
(let ((result_1
(can-direct-eval?
r_0
ns_0
self-mpi_0)))
(values result_1))))
(if (if (not
(let ((x_0 (list r_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t lst_0))))
#f)
(if (parsed-id? p_0)
(not (eq? (get-id-value p_0 ns_0 self-mpi_0) not-available))
(if (parsed-quote? p_0) #t (if (parsed-quote-syntax? p_0) #t #f))))))
(define direct-eval
(lambda (p_0 ns_0 self-mpi_0)
(if (parsed-app? p_0)
(let ((app_0 (direct-eval (parsed-app-rator p_0) ns_0 self-mpi_0)))
(apply
app_0
(reverse$1
(let ((lst_0 (parsed-app-rands p_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((r_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(direct-eval r_0 ns_0 self-mpi_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
(if (parsed-id? p_0)
(get-id-value p_0 ns_0 self-mpi_0)
(if (parsed-quote? p_0)
(parsed-quote-datum p_0)
(if (parsed-quote-syntax? p_0)
(parsed-quote-syntax-datum p_0)
#f))))))
(define get-id-value
(lambda (p_0 ns_0 self-mpi_0)
(let ((b_0 (parsed-id-binding p_0)))
(if (parsed-primitive-id? p_0)
(let ((app_0 (primitive-table '|#%kernel|)))
(hash-ref app_0 (module-binding-sym b_0) get-not-available))
(if (let ((or-part_0 (parsed-top-id? p_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (not b_0)))
(if or-part_1
or-part_1
(eq? self-mpi_0 (module-binding-module b_0))))))
(let ((app_0
(if b_0 (module-binding-phase b_0) (namespace-phase ns_0))))
(namespace-get-variable
ns_0
app_0
(if b_0 (module-binding-sym b_0) (syntax-e$1 (parsed-s p_0)))
get-not-available))
(let ((mi_0
(let ((temp2_0
(1/module-path-index-resolve
(module-binding-module b_0))))
(let ((temp3_0
(phase-
(namespace-phase ns_0)
(module-binding-phase b_0))))
(let ((temp2_1 temp2_0))
(namespace->module-instance.1
#f
#f
void
ns_0
temp2_1
temp3_0))))))
(if (not mi_0)
not-available
(if (let ((app_0 (module-binding-phase b_0)))
(let ((app_1 (module-binding-sym b_0)))
(check-single-require-access
mi_0
app_0
app_1
(module-binding-extra-inspector b_0))))
(let ((app_0 (module-binding-phase b_0)))
(namespace-get-variable
(module-instance-namespace mi_0)
app_0
(module-binding-sym b_0)
get-not-available))
not-available))))))))
(define runtime-scope (new-multi-scope))
(define runtime-stx (add-scope empty-syntax runtime-scope))
(define runtime-module-name (1/make-resolved-module-path '|#%runtime|))
(define runtime-mpi (1/module-path-index-join ''|#%runtime| #f))
(define add-runtime-primitive!
(lambda (sym_0)
(let ((temp1_0 (syntax-scope-set runtime-stx 0)))
(let ((temp3_0
(make-module-binding.1
#f
null
#f
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
runtime-mpi
0
sym_0)))
(let ((temp1_1 temp1_0))
(add-binding-in-scopes!.1 #f temp1_1 sym_0 temp3_0))))))
(define effect_2796
(begin
(void
(begin
(add-runtime-primitive! 'values)
(add-runtime-primitive! 'cons)
(add-runtime-primitive! 'list)
(add-runtime-primitive! 'make-struct-type)
(add-runtime-primitive! 'make-struct-type-property)
(add-runtime-primitive! 'gensym)
(add-runtime-primitive! 'string->uninterned-symbol)))
(void)))
(define runtime-instances
'(|#%kernel|
|#%paramz|
|#%foreign|
|#%unsafe|
|#%flfxnum|
|#%extfl|
|#%network|
|#%place|
|#%futures|))
(define box-cons! (lambda (b_0 v_0) (set-box! b_0 (cons v_0 (unbox b_0)))))
(define box-clear!
(lambda (b_0) (begin0 (reverse$1 (unbox b_0)) (set-box! b_0 null))))
(define struct:lift-context
(make-record-type-descriptor*
'lift-context
#f
(|#%nongenerative-uid| lift-context)
#f
#f
3
0))
(define effect_2900
(struct-type-install-properties!
struct:lift-context
'lift-context
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'lift-context))
(define lift-context1.1
(|#%name|
lift-context
(record-constructor
(make-record-constructor-descriptor struct:lift-context #f #f))))
(define lift-context?
(|#%name| lift-context? (record-predicate struct:lift-context)))
(define lift-context-convert
(|#%name| lift-context-convert (record-accessor struct:lift-context 0)))
(define lift-context-lifts
(|#%name| lift-context-lifts (record-accessor struct:lift-context 1)))
(define lift-context-module*-ok?
(|#%name| lift-context-module*-ok? (record-accessor struct:lift-context 2)))
(define struct:lifted-bind
(make-record-type-descriptor*
'lifted-bind
#f
(|#%nongenerative-uid| lifted-bind)
#f
#f
3
0))
(define effect_3182
(struct-type-install-properties!
struct:lifted-bind
'lifted-bind
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'lifted-bind))
(define lifted-bind2.1
(|#%name|
lifted-bind
(record-constructor
(make-record-constructor-descriptor struct:lifted-bind #f #f))))
(define lifted-bind?
(|#%name| lifted-bind? (record-predicate struct:lifted-bind)))
(define lifted-bind-ids
(|#%name| lifted-bind-ids (record-accessor struct:lifted-bind 0)))
(define lifted-bind-keys
(|#%name| lifted-bind-keys (record-accessor struct:lifted-bind 1)))
(define lifted-bind-rhs
(|#%name| lifted-bind-rhs (record-accessor struct:lifted-bind 2)))
(define make-lift-context.1
(|#%name|
make-lift-context
(lambda (module*-ok?3_0 convert5_0)
(begin (lift-context1.1 convert5_0 (box null) module*-ok?3_0)))))
(define add-lifted!
(lambda (lifts_0 ids_0 rhs_0 phase_0)
(call-with-values
(lambda () (|#%app| (lift-context-convert lifts_0) ids_0 rhs_0 phase_0))
(case-lambda
((lifted-ids_0 lifted_0)
(begin (box-cons! (lift-context-lifts lifts_0) lifted_0) lifted-ids_0))
(args (raise-binding-result-arity-error 2 args))))))
(define get-and-clear-lifts!
(lambda (lifts_0) (box-clear! (lift-context-lifts lifts_0))))
(define make-local-lift
(lambda (lift-env_0 counter_0 local-sym_0)
(lambda (ids_0 rhs_0 phase_0)
(let ((keys_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((key_0
(add-local-binding!.1
#f
#f
local-sym_0
id_0
phase_0
counter_0)))
(begin
(set-box!
lift-env_0
(let ((env_0
(unbox lift-env_0)))
(begin-unsafe
(hash-set
env_0
key_0
variable))))
key_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))))))
(values ids_0 (lifted-bind2.1 ids_0 keys_0 rhs_0))))))
(define make-top-level-lift
(lambda (ctx_0)
(lambda (ids_0 rhs_0 phase_0)
(let ((post-scope_0
(post-expansion-scope
(let ((v_0
(namespace-get-root-expand-ctx
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0))))))
(begin-unsafe
(root-expand-context/outer-post-expansion v_0))))))
(let ((tl-ids_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope id_0 post-scope_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 ((syms_0 (select-defined-syms-and-bind!/ctx tl-ids_0 ctx_0)))
(values tl-ids_0 (lifted-bind2.1 tl-ids_0 syms_0 rhs_0))))))))
(define wrap-lifts-as-let
(lambda (lifts_0 body_0 phase_0)
(datum->syntax$1
#f
(let ((lst_0 (reverse$1 lifts_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (body_1 lst_1)
(begin
(if (pair? lst_1)
(let ((lift_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((body_2
(let ((body_2
(begin
(if (lifted-bind? lift_0)
(void)
(error
"non-bindings in `lift-context`"))
(let ((app_0
(datum->syntax$1
(syntax-shift-phase-level$1
core-stx
phase_0)
'let-values)))
(list
app_0
(list
(list
(lifted-bind-ids lift_0)
(lifted-bind-rhs lift_0)))
body_1)))))
(values body_2))))
(for-loop_0 body_2 rest_0))))
body_1))))))
(for-loop_0 body_0 lst_0)))))))
(define wrap-lifts-as-begin.1
(|#%name|
wrap-lifts-as-begin
(lambda (adjust-body8_0 adjust-form7_0 lifts11_0 body12_0 phase13_0)
(begin
(let ((adjust-form_0
(if (eq? adjust-form7_0 unsafe-undefined)
values
adjust-form7_0)))
(let ((adjust-body_0
(if (eq? adjust-body8_0 unsafe-undefined)
values
adjust-body8_0)))
(datum->syntax$1
#f
(let ((app_0
(datum->syntax$1
(syntax-shift-phase-level$1 core-stx phase13_0)
'begin)))
(cons
app_0
(let ((app_1
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((lift_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(|#%app|
adjust-form_0
(if (lifted-bind?
lift_0)
(datum->syntax$1
#f
(list
(datum->syntax$1
(syntax-shift-phase-level$1
core-stx
phase13_0)
'define-values)
(lifted-bind-ids
lift_0)
(lifted-bind-rhs
lift_0)))
lift_0))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lifts11_0))))))
(append
app_1
(list (|#%app| adjust-body_0 body12_0)))))))))))))
(define get-lifts-as-lists
(lambda (lifts_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((lift_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(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
(make-record-type-descriptor*
'module-lift-context
#f
(|#%nongenerative-uid| module-lift-context)
#f
#f
3
0))
(define effect_2402
(struct-type-install-properties!
struct:module-lift-context
'module-lift-context
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'module-lift-context))
(define module-lift-context15.1
(|#%name|
module-lift-context
(record-constructor
(make-record-constructor-descriptor struct:module-lift-context #f #f))))
(define module-lift-context?
(|#%name|
module-lift-context?
(record-predicate struct:module-lift-context)))
(define module-lift-context-wrt-phase
(|#%name|
module-lift-context-wrt-phase
(record-accessor struct:module-lift-context 0)))
(define module-lift-context-lifts
(|#%name|
module-lift-context-lifts
(record-accessor struct:module-lift-context 1)))
(define module-lift-context-module*-ok?
(|#%name|
module-lift-context-module*-ok?
(record-accessor struct:module-lift-context 2)))
(define make-module-lift-context
(lambda (phase_0 module*-ok?_0)
(module-lift-context15.1 phase_0 (box null) module*-ok?_0)))
(define get-and-clear-module-lifts!
(lambda (module-lifts_0)
(box-clear! (module-lift-context-lifts module-lifts_0))))
(define add-lifted-module!
(lambda (module-lifts_0 s_0 phase_0)
(begin
(if (let ((or-part_0
(if (module-lift-context? module-lifts_0)
(module-lift-context-module*-ok? module-lifts_0)
#f)))
(if or-part_0
or-part_0
(if (lift-context? module-lifts_0)
(lift-context-module*-ok? module-lifts_0)
#f)))
(void)
(let ((tmp_0 (core-form-sym s_0 phase_0)))
(if (eq? tmp_0 'module)
(void)
(if (eq? tmp_0 'module*)
(raise-arguments-error
'syntax-local-lift-module
"cannot lift `module*' to a top-level context"
"syntax"
s_0)
(raise-arguments-error
'syntax-local-lift-module
"not a `module' declaration"
"syntax"
s_0)))))
(if (module-lift-context? module-lifts_0)
(box-cons! (module-lift-context-lifts module-lifts_0) s_0)
(if (lift-context? module-lifts_0)
(box-cons! (lift-context-lifts module-lifts_0) s_0)
(error
"internal error: unrecognized lift-context type for module lift"))))))
(define struct:require-lift-context
(make-record-type-descriptor*
'require-lift-context
#f
(|#%nongenerative-uid| require-lift-context)
#f
#f
3
0))
(define effect_2549
(struct-type-install-properties!
struct:require-lift-context
'require-lift-context
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'require-lift-context))
(define require-lift-context16.1
(|#%name|
require-lift-context
(record-constructor
(make-record-constructor-descriptor struct:require-lift-context #f #f))))
(define require-lift-context?
(|#%name|
require-lift-context?
(record-predicate struct:require-lift-context)))
(define require-lift-context-do-require
(|#%name|
require-lift-context-do-require
(record-accessor struct:require-lift-context 0)))
(define require-lift-context-wrt-phase
(|#%name|
require-lift-context-wrt-phase
(record-accessor struct:require-lift-context 1)))
(define require-lift-context-requires
(|#%name|
require-lift-context-requires
(record-accessor struct:require-lift-context 2)))
(define make-require-lift-context
(lambda (wrt-phase_0 do-require_0)
(require-lift-context16.1 do-require_0 wrt-phase_0 (box null))))
(define get-and-clear-require-lifts!
(lambda (require-lifts_0)
(box-clear! (require-lift-context-requires require-lifts_0))))
(define add-lifted-require!
(lambda (require-lifts_0 s_0 phase_0)
(begin
(|#%app| (require-lift-context-do-require require-lifts_0) s_0 phase_0)
(box-cons! (require-lift-context-requires require-lifts_0) s_0))))
(define struct:to-module-lift-context
(make-record-type-descriptor*
'to-module-lift-context
#f
(|#%nongenerative-uid| to-module-lift-context)
#f
#f
4
0))
(define effect_3102
(struct-type-install-properties!
struct:to-module-lift-context
'to-module-lift-context
4
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3)
#f
'to-module-lift-context))
(define to-module-lift-context17.1
(|#%name|
to-module-lift-context
(record-constructor
(make-record-constructor-descriptor struct:to-module-lift-context #f #f))))
(define to-module-lift-context?
(|#%name|
to-module-lift-context?
(record-predicate struct:to-module-lift-context)))
(define to-module-lift-context-wrt-phase
(|#%name|
to-module-lift-context-wrt-phase
(record-accessor struct:to-module-lift-context 0)))
(define to-module-lift-context-provides
(|#%name|
to-module-lift-context-provides
(record-accessor struct:to-module-lift-context 1)))
(define to-module-lift-context-end-as-expressions?
(|#%name|
to-module-lift-context-end-as-expressions?
(record-accessor struct:to-module-lift-context 2)))
(define to-module-lift-context-ends
(|#%name|
to-module-lift-context-ends
(record-accessor struct:to-module-lift-context 3)))
(define make-to-module-lift-context.1
(|#%name|
make-to-module-lift-context
(lambda (end-as-expressions?19_0 shared-module-ends18_0 phase22_0)
(begin
(to-module-lift-context17.1
phase22_0
(box null)
end-as-expressions?19_0
shared-module-ends18_0)))))
(define make-shared-module-ends (lambda () (box null)))
(define get-and-clear-end-lifts!
(lambda (to-module-lifts_0)
(box-clear! (to-module-lift-context-ends to-module-lifts_0))))
(define get-and-clear-provide-lifts!
(lambda (to-module-lifts_0)
(box-clear! (to-module-lift-context-provides to-module-lifts_0))))
(define add-lifted-to-module-provide!
(lambda (to-module-lifts_0 s_0 phase_0)
(box-cons! (to-module-lift-context-provides to-module-lifts_0) s_0)))
(define add-lifted-to-module-end!
(lambda (to-module-lifts_0 s_0 phase_0)
(box-cons! (to-module-lift-context-ends to-module-lifts_0) s_0)))
(define struct:already-expanded
(make-record-type-descriptor*
'expanded-syntax
#f
(|#%nongenerative-uid| expanded-syntax)
#f
#f
2
0))
(define effect_2070
(struct-type-install-properties!
struct:already-expanded
'expanded-syntax
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'already-expanded))
(define already-expanded1.1
(|#%name|
already-expanded
(record-constructor
(make-record-constructor-descriptor struct:already-expanded #f #f))))
(define already-expanded?_1849
(|#%name| expanded-syntax? (record-predicate struct:already-expanded)))
(define already-expanded?
(|#%name|
expanded-syntax?
(lambda (v)
(if (already-expanded?_1849 v)
#t
($value
(if (impersonator? v)
(already-expanded?_1849 (impersonator-val v))
#f))))))
(define already-expanded-s_2877
(|#%name| expanded-syntax-s (record-accessor struct:already-expanded 0)))
(define already-expanded-s
(|#%name|
expanded-syntax-s
(lambda (s)
(if (already-expanded?_1849 s)
(already-expanded-s_2877 s)
($value
(impersonate-ref
already-expanded-s_2877
struct:already-expanded
0
s
'expanded-syntax
's))))))
(define already-expanded-binding-layer_2482
(|#%name|
expanded-syntax-binding-layer
(record-accessor struct:already-expanded 1)))
(define already-expanded-binding-layer
(|#%name|
expanded-syntax-binding-layer
(lambda (s)
(if (already-expanded?_1849 s)
(already-expanded-binding-layer_2482 s)
($value
(impersonate-ref
already-expanded-binding-layer_2482
struct:already-expanded
1
s
'expanded-syntax
'binding-layer))))))
(define-values
(1/prop:liberal-define-context
has-liberal-define-context-property?
liberal-define-context-value)
(make-struct-type-property 'liberal-define-context))
(define struct:liberal-define-context
(make-record-type-descriptor*
'liberal-define-context
#f
(|#%nongenerative-uid| liberal-define-context)
#f
#f
0
0))
(define effect_2200
(struct-type-install-properties!
struct:liberal-define-context
'liberal-define-context
0
0
#f
(list (cons 1/prop:liberal-define-context #t))
#f
#f
'()
#f
'make-liberal-define-context))
(define make-liberal-define-context
(|#%name|
make-liberal-define-context
(record-constructor
(make-record-constructor-descriptor struct:liberal-define-context #f #f))))
(define 1/liberal-define-context?_2641
(|#%name|
liberal-define-context?
(record-predicate struct:liberal-define-context)))
(define 1/liberal-define-context?
(|#%name|
liberal-define-context?
(lambda (v)
(if (1/liberal-define-context?_2641 v)
#t
($value
(if (impersonator? v)
(1/liberal-define-context?_2641 (impersonator-val v))
#f))))))
(define-values
(1/prop:expansion-contexts expansion-contexts? expansion-contexts-ref)
(make-struct-type-property
'expansion-contexts
(lambda (v_0 info_0)
(begin
(if (if (list? v_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_0)
(begin
(if (pair? lst_0)
(let ((s_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((result_1
(let ((result_1
(memq
s_0
'(expression
top-level
module
module-begin
definition-context))))
(values result_1))))
(if (if (not
(let ((x_0 (list s_0))) (not result_1)))
#t
#f)
(for-loop_0 result_1 rest_0)
result_1))))
result_0))))))
(for-loop_0 #t v_0)))
#f)
(void)
(raise-argument-error
'guard-for-prop:expansion-contexts
"(listof (or/c 'expression 'top-level 'module 'module-begin 'definition-context))"
v_0))
v_0))))
(define not-in-this-expand-context?
(lambda (t_0 ctx_0)
(if (expansion-contexts? t_0)
(not
(let ((app_0
(context->symbol
(begin-unsafe (expand-context/outer-context ctx_0)))))
(memq app_0 (expansion-contexts-ref t_0))))
#f)))
(define context->symbol
(lambda (context_0) (if (symbol? context_0) context_0 'definition-context)))
(define avoid-current-expand-context
(lambda (s_0 t_0 ctx_0)
(let ((wrap_0
(|#%name|
wrap
(lambda (sym_0)
(begin
(datum->syntax$1
#f
(list
(syntax-shift-phase-level$1
(datum->syntax$1 core-stx sym_0)
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))
s_0)))))))
(let ((fail_0
(|#%name|
fail
(lambda ()
(begin
(raise-syntax-error$1
#f
(format
"not allowed in context\n expansion context: ~a"
(context->symbol
(begin-unsafe (expand-context/outer-context ctx_0))))
s_0))))))
(let ((tmp_0
(context->symbol
(begin-unsafe (expand-context/outer-context ctx_0)))))
(if (eq? tmp_0 'module-begin)
(wrap_0 'begin)
(if (if (eq? tmp_0 'module)
#t
(if (eq? tmp_0 'top-level)
#t
(eq? tmp_0 'definition-context)))
(if (memq 'expression (expansion-contexts-ref t_0))
(wrap_0 '|#%expression|)
(fail_0))
(fail_0))))))))
(define struct:reference-record
(make-record-type-descriptor*
'reference-record
#f
(|#%nongenerative-uid| reference-record)
#f
#f
3
7))
(define effect_2434
(struct-type-install-properties!
struct:reference-record
'reference-record
3
0
#f
(list (cons prop:authentic #t))
#f
#f
'()
#f
'reference-record))
(define reference-record1.1
(|#%name|
reference-record
(record-constructor
(make-record-constructor-descriptor struct:reference-record #f #f))))
(define reference-record?
(|#%name| reference-record? (record-predicate struct:reference-record)))
(define reference-record-already-bound
(|#%name|
reference-record-already-bound
(record-accessor struct:reference-record 0)))
(define reference-record-reference-before-bound
(|#%name|
reference-record-reference-before-bound
(record-accessor struct:reference-record 1)))
(define reference-record-all-referenced?
(|#%name|
reference-record-all-referenced?
(record-accessor struct:reference-record 2)))
(define set-reference-record-already-bound!
(|#%name|
set-reference-record-already-bound!
(record-mutator struct:reference-record 0)))
(define set-reference-record-reference-before-bound!
(|#%name|
set-reference-record-reference-before-bound!
(record-mutator struct:reference-record 1)))
(define set-reference-record-all-referenced?!
(|#%name|
set-reference-record-all-referenced?!
(record-mutator struct:reference-record 2)))
(define make-reference-record
(lambda () (let ((app_0 (seteq))) (reference-record1.1 app_0 (seteq) #f))))
(define reference-record-used!
(lambda (rr_0 key_0)
(if (let ((s_0 (reference-record-already-bound rr_0)))
(begin-unsafe (hash-ref s_0 key_0 #f)))
(void)
(set-reference-record-reference-before-bound!
rr_0
(let ((s_0 (reference-record-reference-before-bound rr_0)))
(begin-unsafe (hash-set s_0 key_0 #t)))))))
(define reference-records-all-used!
(lambda (rrs_0)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((rr_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((next-k-proc_0
(|#%name|
next-k-proc
(lambda () (begin (for-loop_0 rest_0))))))
(if (reference-record-all-referenced? rr_0)
(values)
(begin
(set-reference-record-all-referenced?! rr_0 #t)
(next-k-proc_0))))))
(values)))))))
(for-loop_0 rrs_0)))
(void))))
(define reference-record-bound!
(lambda (rr_0 keys_0)
(begin
(set-reference-record-already-bound!
rr_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ab_0 lst_0)
(begin
(if (pair? lst_0)
(let ((key_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((ab_1
(let ((ab_1
(begin-unsafe (hash-set ab_0 key_0 #t))))
(values ab_1))))
(for-loop_0 ab_1 rest_0))))
ab_0))))))
(for-loop_0 (reference-record-already-bound rr_0) keys_0))))
(set-reference-record-reference-before-bound!
rr_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (rbb_0 lst_0)
(begin
(if (pair? lst_0)
(let ((key_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((rbb_1
(let ((rbb_1
(begin-unsafe (hash-remove rbb_0 key_0))))
(values rbb_1))))
(for-loop_0 rbb_1 rest_0))))
rbb_0))))))
(for-loop_0
(reference-record-reference-before-bound rr_0)
keys_0)))))))
(define reference-record-forward-references?
(lambda (rr_0)
(let ((or-part_0 (reference-record-all-referenced? rr_0)))
(if or-part_0
or-part_0
(positive?
(let ((s_0 (reference-record-reference-before-bound rr_0)))
(begin-unsafe (hash-count s_0))))))))
(define reference-record-clear!
(lambda (rr_0)
(begin
(set-reference-record-already-bound! rr_0 #f)
(set-reference-record-reference-before-bound! rr_0 #f))))
(define call-expand-observe
(lambda (obs_0 key_0 . args_0)
(begin
(let ((c1_0 (hash-ref key->arity key_0 #f)))
(if c1_0
(if (let ((or-part_0 (eq? c1_0 'any)))
(if or-part_0 or-part_0 (eqv? (length args_0) c1_0)))
(void)
(error 'call-expand-observe "wrong arity for ~s: ~e" key_0 args_0))
(error 'call-expand-observe "bad key: ~s" key_0)))
(|#%app| obs_0 key_0 (if (null? args_0) #f (apply list* args_0))))))
(define key->arity hash3012)
(define rebuild.1
(|#%name|
rebuild
(lambda (track?1_0 orig-s3_0 new4_0)
(begin
(syntax-rearm$1
(let ((app_0 (syntax-disarm$1 orig-s3_0)))
(datum->syntax$1 app_0 new4_0 orig-s3_0 (if track?1_0 orig-s3_0 #f)))
orig-s3_0)))))
(define struct:expanded+parsed
(make-record-type-descriptor*
'expanded+parsed
#f
(|#%nongenerative-uid| expanded+parsed)
#f
#f
2
0))
(define effect_2902
(struct-type-install-properties!
struct:expanded+parsed
'expanded+parsed
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'expanded+parsed))
(define expanded+parsed1.1
(|#%name|
expanded+parsed
(record-constructor
(make-record-constructor-descriptor struct:expanded+parsed #f #f))))
(define expanded+parsed?
(|#%name| expanded+parsed? (record-predicate struct:expanded+parsed)))
(define expanded+parsed-s
(|#%name| expanded+parsed-s (record-accessor struct:expanded+parsed 0)))
(define expanded+parsed-parsed
(|#%name| expanded+parsed-parsed (record-accessor struct:expanded+parsed 1)))
(define struct:semi-parsed-define-values
(make-record-type-descriptor*
'semi-parsed-define-values
#f
(|#%nongenerative-uid| semi-parsed-define-values)
#f
#f
4
0))
(define effect_2257
(struct-type-install-properties!
struct:semi-parsed-define-values
'semi-parsed-define-values
4
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3)
#f
'semi-parsed-define-values))
(define semi-parsed-define-values2.1
(|#%name|
semi-parsed-define-values
(record-constructor
(make-record-constructor-descriptor
struct:semi-parsed-define-values
#f
#f))))
(define semi-parsed-define-values?
(|#%name|
semi-parsed-define-values?
(record-predicate struct:semi-parsed-define-values)))
(define semi-parsed-define-values-s
(|#%name|
semi-parsed-define-values-s
(record-accessor struct:semi-parsed-define-values 0)))
(define semi-parsed-define-values-syms
(|#%name|
semi-parsed-define-values-syms
(record-accessor struct:semi-parsed-define-values 1)))
(define semi-parsed-define-values-ids
(|#%name|
semi-parsed-define-values-ids
(record-accessor struct:semi-parsed-define-values 2)))
(define semi-parsed-define-values-rhs
(|#%name|
semi-parsed-define-values-rhs
(record-accessor struct:semi-parsed-define-values 3)))
(define struct:semi-parsed-begin-for-syntax
(make-record-type-descriptor*
'semi-parsed-begin-for-syntax
#f
(|#%nongenerative-uid| semi-parsed-begin-for-syntax)
#f
#f
2
0))
(define effect_2603
(struct-type-install-properties!
struct:semi-parsed-begin-for-syntax
'semi-parsed-begin-for-syntax
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'semi-parsed-begin-for-syntax))
(define semi-parsed-begin-for-syntax3.1
(|#%name|
semi-parsed-begin-for-syntax
(record-constructor
(make-record-constructor-descriptor
struct:semi-parsed-begin-for-syntax
#f
#f))))
(define semi-parsed-begin-for-syntax?
(|#%name|
semi-parsed-begin-for-syntax?
(record-predicate struct:semi-parsed-begin-for-syntax)))
(define semi-parsed-begin-for-syntax-s
(|#%name|
semi-parsed-begin-for-syntax-s
(record-accessor struct:semi-parsed-begin-for-syntax 0)))
(define semi-parsed-begin-for-syntax-body
(|#%name|
semi-parsed-begin-for-syntax-body
(record-accessor struct:semi-parsed-begin-for-syntax 1)))
(define extract-syntax
(lambda (s_0) (if (expanded+parsed? s_0) (expanded+parsed-s s_0) s_0)))
(define parsed-only
(lambda (l_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((i_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(if (let ((or-part_0 (parsed? i_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (expanded+parsed? i_0)))
(if or-part_1
or-part_1
(semi-parsed-begin-for-syntax? i_0)))))
(let ((fold-var_1
(cons
(if (expanded+parsed? i_0)
(expanded+parsed-parsed i_0)
(if (semi-parsed-begin-for-syntax? i_0)
(parsed-begin-for-syntax21.1
(semi-parsed-begin-for-syntax-s i_0)
(parsed-only
(semi-parsed-begin-for-syntax-body
i_0)))
i_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 l_0))))))
(define syntax-only
(lambda (l_0)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((i_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(if (let ((or-part_0 (syntax?$1 i_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (expanded+parsed? i_0)))
(if or-part_1
or-part_1
(semi-parsed-begin-for-syntax? i_0)))))
(let ((fold-var_1
(cons
(if (expanded+parsed? i_0)
(expanded+parsed-s i_0)
(if (semi-parsed-begin-for-syntax? i_0)
(let ((s_0
(semi-parsed-begin-for-syntax-s
i_0)))
(let ((nested-bodys_0
(semi-parsed-begin-for-syntax-body
i_0)))
(let ((disarmed-s_0
(syntax-disarm$1 s_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1
disarmed-s_0)
(syntax-e$1
disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((begin-for-syntax9_0
(let ((s_2
(car
s_1)))
s_2)))
(let ((_0
(let ((s_2
(cdr
s_1)))
(let ((s_3
(if (syntax?$1
s_2)
(syntax-e$1
s_2)
s_2)))
(let ((flat-s_0
(to-syntax-list.1
s_3)))
(if (not
flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0))))))
(let ((begin-for-syntax9_1
begin-for-syntax9_0))
(values
begin-for-syntax9_1
_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((begin-for-syntax7_0 _0)
(values
#t
begin-for-syntax7_0
_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
begin-for-syntax7_0
_0)
(let ((temp12_0
(list*
begin-for-syntax7_0
(syntax-only
nested-bodys_0))))
(rebuild.1
#t
s_0
temp12_0)))
(args
(raise-binding-result-arity-error
3
args)))))))
i_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 l_0))))))
(define implicit-made-explicit-properties (hasheq 'implicit-made-explicit #t))
(define original-implicit-made-explicit-properties
(hash-set implicit-made-explicit-properties original-property-sym #t))
(define expand.1
(|#%name|
expand
(lambda (alternate-id1_0 fail-non-transformer2_0 s5_0 ctx6_0)
(begin
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx6_0)))))
(if obs_0 (call-expand-observe obs_0 'visit s5_0) (void)))
(let ((content_0 (syntax-content s5_0)))
(if (symbol? content_0)
(expand-identifier s5_0 ctx6_0 alternate-id1_0)
(if (if (pair? content_0)
(let ((s_0 (car content_0)))
(begin-unsafe (symbol? (syntax-content s_0))))
#f)
(expand-id-application-form.1
fail-non-transformer2_0
s5_0
ctx6_0
alternate-id1_0)
(if (let ((or-part_0 (pair? content_0)))
(if or-part_0 or-part_0 (null? content_0)))
(expand-implicit '|#%app| s5_0 ctx6_0 #f)
(if (already-expanded? content_0)
(expand-already-expanded s5_0 ctx6_0)
(expand-implicit '|#%datum| s5_0 ctx6_0 #f)))))))))))
(define expand-identifier
(lambda (s_0 ctx_0 alternate-id_0)
(let ((id_0 (if alternate-id_0 alternate-id_0 s_0)))
(if (if (not
(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))))
(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
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(begin
(call-expand-observe obs_0 'resolve id_0)
(call-expand-observe obs_0 'stop/return s_0))
(void)))
s_0)
(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
(lambda (fail-non-transformer8_0 s10_0 ctx11_0 alternate-id12_0)
(begin
(let ((id_0
(if alternate-id12_0
alternate-id12_0
(car (syntax-e/no-taint s10_0)))))
(if (if (not
(let ((fs_0
(begin-unsafe
(expand-context/inner-stops
(root-expand-context/outer-inner ctx11_0)))))
(begin-unsafe (eq? fs_0 empty-free-id-set))))
(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
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx11_0)))))
(if obs_0
(begin
(call-expand-observe obs_0 'resolve id_0)
(call-expand-observe obs_0 'stop/return s10_0))
(void)))
s10_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))
(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))
(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)))))))))))))))
(define expand-implicit
(lambda (sym_0 s_0 ctx_0 trigger-id_0)
(if (begin-unsafe (expand-context/outer-only-immediate? ctx_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 'stop/return s_0) (void)))
s_0)
(let ((disarmed-s_0 (syntax-disarm$1 s_0)))
(let ((id_0 (datum->syntax$1 disarmed-s_0 sym_0)))
(if (if (not
(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))))
(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
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(begin
(call-expand-observe obs_0 'resolve id_0)
(call-expand-observe obs_0 'stop/return s_0))
(void)))
s_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
null
#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
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-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))))))))))))))
(define expand-already-expanded
(lambda (s_0 ctx_0)
(let ((ae_0 (syntax-e$1 s_0)))
(let ((exp-s_0 (already-expanded-s ae_0)))
(begin
(if (let ((or-part_0 (syntax-any-macro-scopes? s_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(not
(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)
(not
(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))
#f)))))
(let ((app_0
(string-append
"expanded syntax not in its original lexical context;\n"
" extra bindings or scopes in the current context")))
(raise-syntax-error$1
#f
app_0
(if (not (parsed? exp-s_0)) exp-s_0 #f)))
(void))
(if (begin-unsafe (expand-context/outer-only-immediate? ctx_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 'stop/return s_0) (void)))
s_0)
(if (parsed? exp-s_0)
exp-s_0
(let ((result-s_0 (syntax-track-origin$1 exp-s_0 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 'opaque-expr result-s_0)
(void)))
(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)
(expand.1 #f #f result-s_0 ctx_0)
result-s_0))))))))))
(define make-explicit
(lambda (ctx_0 sym_0 s_0 disarmed-s_0)
(let ((insp_0 (current-module-code-inspector)))
(let ((sym-s_0
(immediate-datum->syntax
disarmed-s_0
sym_0
s_0
(if (begin-unsafe
(hash-ref (syntax-props s_0) original-property-sym #f))
original-implicit-made-explicit-properties
implicit-made-explicit-properties)
insp_0)))
(let ((new-s_0
(syntax-rearm$1
(immediate-datum->syntax
disarmed-s_0
(cons sym-s_0 disarmed-s_0)
s_0
(syntax-props s_0)
insp_0)
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 'tag2 new-s_0 disarmed-s_0)
(void)))
new-s_0))))))
(define dispatch.1
(|#%name|
dispatch
(lambda (fail-non-transformer14_0
t16_0
insp-of-t17_0
s18_0
id19_0
ctx20_0
binding21_0
primitive?22_0
protected?23_0)
(begin
(if (core-form? t16_0)
(dispatch-core-form t16_0 s18_0 ctx20_0)
(if (transformer? t16_0)
(dispatch-transformer.1
fail-non-transformer14_0
t16_0
insp-of-t17_0
s18_0
id19_0
ctx20_0
binding21_0)
(if (variable? t16_0)
(dispatch-variable
t16_0
s18_0
id19_0
ctx20_0
binding21_0
primitive?22_0
protected?23_0)
(raise-syntax-error$1
#f
"illegal use of syntax"
s18_0
#f
null
(format
"\n value at phase ~s: ~e"
(add1
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx20_0))))
t16_0)))))))))
(define dispatch-core-form
(lambda (t_0 s_0 ctx_0)
(if (begin-unsafe (expand-context/outer-only-immediate? ctx_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 'stop/return s_0) (void)))
s_0)
(if (begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_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 'enter-prim s_0) (void)))
(let ((result-s_0 (|#%app| (core-form-expander t_0) s_0 ctx_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
'exit-prim/return
(extract-syntax result-s_0))
(void)))
result-s_0)))
(|#%app| (core-form-expander t_0) s_0 ctx_0)))))
(define |dispatch-implicit-#%top-core-form|
(lambda (t_0 s_0 ctx_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 'enter-prim s_0) (void)))
(let ((result-s_0 (|#%app| (core-form-expander t_0) s_0 ctx_0 #t)))
(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 'exit-prim/return result-s_0)
(void)))
result-s_0)))))
(define dispatch-transformer.1
(|#%name|
dispatch-transformer
(lambda (fail-non-transformer25_0
t27_0
insp-of-t28_0
s29_0
id30_0
ctx31_0
binding32_0)
(begin
(if (not-in-this-expand-context? t27_0 ctx31_0)
(let ((adj-s_0
(avoid-current-expand-context
(substitute-alternate-id s29_0 id30_0)
t27_0
ctx31_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx31_0)))))
(if obs_0
(call-expand-observe obs_0 'tag/context adj-s_0)
(void)))
(expand.1 #f #f adj-s_0 ctx31_0)))
(if (if (begin-unsafe
(expand-context/inner-parsing-expanded?
(root-expand-context/outer-inner ctx31_0)))
(not (1/rename-transformer? t27_0))
#f)
(raise-syntax-error$1
#f
"encountered a macro binding in form that should be fully expanded"
s29_0)
(if (1/rename-transformer? t27_0)
(if (begin-unsafe
(expand-context/inner-just-once?
(root-expand-context/outer-inner ctx31_0)))
s29_0
(let ((alt-id_0
(apply-rename-transformer t27_0 id30_0 ctx31_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx31_0)))))
(if obs_0
(call-expand-observe obs_0 'rename-transformer alt-id_0)
(void)))
(expand.1
alt-id_0
fail-non-transformer25_0
s29_0
ctx31_0))))
(call-with-values
(lambda ()
(apply-transformer.1
#f
t27_0
insp-of-t28_0
s29_0
id30_0
ctx31_0
binding32_0))
(case-lambda
((exp-s_0 re-ctx_0)
(if (begin-unsafe
(expand-context/inner-just-once?
(root-expand-context/outer-inner ctx31_0)))
exp-s_0
(expand.1 #f #f exp-s_0 re-ctx_0)))
(args (raise-binding-result-arity-error 2 args)))))))))))
(define dispatch-variable
(lambda (t_0 s_0 id_0 ctx_0 binding_0 primitive?_0 protected?_0)
(if (begin-unsafe (expand-context/outer-only-immediate? ctx_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 'stop/return id_0) (void)))
id_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 'variable s_0 id_0) (void)))
(begin
(register-variable-referenced-if-local! binding_0 ctx_0)
(let ((result-s_0
(let ((temp178_0
(free-id-set-empty-or-just-module*?
(begin-unsafe
(expand-context/inner-stops
(root-expand-context/outer-inner ctx_0))))))
(substitute-variable.1 temp178_0 id_0 t_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)
(let ((prop-s_0 (begin-unsafe #f)))
(let ((insp_0 (syntax-inspector result-s_0)))
(if primitive?_0
(parsed-primitive-id3.1 prop-s_0 binding_0 insp_0)
(parsed-id2.1 prop-s_0 binding_0 insp_0))))
(let ((protected-result-s_0
(if protected?_0
(syntax-property$1 result-s_0 'protected #t)
result-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 'return protected-result-s_0)
(void)))
protected-result-s_0)))))))))
(define apply-transformer.1
(|#%name|
apply-transformer
(lambda (origin-id34_0 t36_0 insp-of-t37_0 s38_0 id39_0 ctx40_0 binding41_0)
(begin
(begin
(if log-performance?
(start-performance-region 'expand '_ 'macro)
(void))
(begin0
(let ((disarmed-s_0 (syntax-disarm$1 s38_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx40_0)))))
(if obs_0
(call-expand-observe obs_0 'enter-macro disarmed-s_0 s38_0)
(void)))
(let ((intro-scope_0 (new-scope 'macro)))
(let ((intro-s_0 (flip-scope disarmed-s_0 intro-scope_0)))
(call-with-values
(lambda ()
(maybe-add-use-site-scope intro-s_0 ctx40_0 binding41_0))
(case-lambda
((use-s_0 use-scopes_0)
(let ((cleaned-s_0
(syntax-remove-taint-dispatch-properties
use-s_0)))
(let ((def-ctx-scopes_0 (box null)))
(let ((transformed-s_0
(apply-transformer-in-context
t36_0
cleaned-s_0
ctx40_0
insp-of-t37_0
intro-scope_0
use-scopes_0
def-ctx-scopes_0
id39_0)))
(let ((result-s_0
(flip-scope transformed-s_0 intro-scope_0)))
(let ((post-s_0
(begin-unsafe
(apply-post-expansion
(begin-unsafe
(root-expand-context/outer-post-expansion
ctx40_0))
result-s_0))))
(let ((tracked-s_0
(syntax-track-origin$1
post-s_0
cleaned-s_0
(if origin-id34_0
origin-id34_0
(if (begin-unsafe
(symbol?
(syntax-content s38_0)))
s38_0
(car (syntax-e$1 s38_0)))))))
(let ((rearmed-s_0
(taint-dispatch
tracked-s_0
(lambda (t-s_0)
(syntax-rearm$1 t-s_0 s38_0))
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner
ctx40_0))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx40_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-macro
rearmed-s_0
post-s_0)
(void)))
(values
rearmed-s_0
(accumulate-def-ctx-scopes
ctx40_0
def-ctx-scopes_0)))))))))))
(args (raise-binding-result-arity-error 2 args))))))))
(if log-performance? (end-performance-region) (void))))))))
(define apply-transformer-in-context
(lambda (t_0
cleaned-s_0
ctx_0
insp-of-t_0
intro-scope_0
use-scopes_0
def-ctx-scopes_0
id_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 'macro-pre-x cleaned-s_0) (void)))
(let ((confine-def-ctx-scopes?_0
(not
(let ((or-part_0
(begin-unsafe
(expand-context/outer-only-immediate? ctx_0))))
(if or-part_0
or-part_0
(not
(free-id-set-empty-or-just-module*?
(begin-unsafe
(expand-context/inner-stops
(root-expand-context/outer-inner ctx_0))))))))))
(let ((accum-ctx_0
(if (if confine-def-ctx-scopes?_0
(if (begin-unsafe
(expand-context/outer-def-ctx-scopes ctx_0))
(not
(null?
(unbox
(begin-unsafe
(expand-context/outer-def-ctx-scopes ctx_0)))))
#f)
#f)
(accumulate-def-ctx-scopes
ctx_0
(begin-unsafe (expand-context/outer-def-ctx-scopes ctx_0)))
ctx_0)))
(let ((m-ctx_0
(if (expand-context/outer? accum-ctx_0)
(let ((current-introduction-scopes179_0
(list intro-scope_0)))
(let ((def-ctx-scopes181_0
(if confine-def-ctx-scopes?_0
def-ctx-scopes_0
(begin-unsafe
(expand-context/outer-def-ctx-scopes ctx_0)))))
(let ((inner182_0
(root-expand-context/outer-inner accum-ctx_0)))
(let ((def-ctx-scopes181_1 def-ctx-scopes181_0)
(current-introduction-scopes179_1
current-introduction-scopes179_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?"
accum-ctx_0))))
(let ((transformed-s_0
(with-continuation-mark*
push-authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
1/current-namespace
(namespace->namespace-at-phase
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))
(add1
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))))
(with-continuation-mark*
authentic
current-expand-context
m-ctx_0
(with-continuation-mark*
authentic
current-module-code-inspector
insp-of-t_0
(call-with-continuation-barrier
(lambda ()
(|#%app|
(transformer->procedure t_0)
cleaned-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
'macro-post-x
transformed-s_0
cleaned-s_0)
(void)))
(if (syntax?$1 transformed-s_0)
(void)
(raise-arguments-error
(syntax-e$1 id_0)
"received value from syntax expander was not syntax"
"received"
transformed-s_0))
transformed-s_0))))))))
(define maybe-add-use-site-scope
(lambda (s_0 ctx_0 binding_0)
(if (if (begin-unsafe (root-expand-context/outer-use-site-scopes ctx_0))
(matching-frame?
(begin-unsafe (root-expand-context/outer-frame-id ctx_0))
(binding-frame-id binding_0))
#f)
(let ((sc_0 (new-scope 'use-site)))
(let ((b_0
(begin-unsafe
(root-expand-context/outer-use-site-scopes ctx_0))))
(begin
(set-box! b_0 (cons sc_0 (unbox b_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)
(if current-frame-id_0
(let ((or-part_0 (eq? current-frame-id_0 bind-frame-id_0)))
(if or-part_0 or-part_0 (eq? current-frame-id_0 'all)))
#f)))
(define maybe-add-post-expansion
(lambda (s_0 ctx_0)
(apply-post-expansion
(begin-unsafe (root-expand-context/outer-post-expansion ctx_0))
s_0)))
(define accumulate-def-ctx-scopes
(lambda (ctx_0 def-ctx-scopes_0)
(if (null? (unbox def-ctx-scopes_0))
ctx_0
(if (expand-context/outer? ctx_0)
(let ((scopes183_0
(append
(unbox def-ctx-scopes_0)
(begin-unsafe (expand-context/outer-scopes ctx_0)))))
(let ((inner184_0 (root-expand-context/outer-inner ctx_0)))
(let ((scopes183_1 scopes183_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)
(let ((target-id_0 (rename-transformer-target-in-context t_0 ctx_0)))
(let ((intro-scope_0 (new-scope 'macro)))
(let ((intro-id_0 (add-scope target-id_0 intro-scope_0)))
(syntax-track-origin$1
(transfer-srcloc intro-id_0 id_0)
id_0
id_0))))))
(define lookup.1
(|#%name|
lookup
(lambda (in43_0 out-of-context-as-variable?44_0 b47_0 ctx48_0 id49_0)
(begin
(let ((temp186_0 (begin-unsafe (expand-context/outer-env ctx48_0))))
(let ((temp187_0
(begin-unsafe
(expand-context/inner-lift-envs
(root-expand-context/outer-inner ctx48_0)))))
(let ((temp188_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx48_0)))))
(let ((temp189_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx48_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)
s_0
(if (begin-unsafe (symbol? (syntax-content s_0)))
(syntax-rearm$1 (syntax-track-origin$1 alternate-id_0 s_0) s_0)
(let ((disarmed-s_0 (syntax-disarm$1 s_0)))
(syntax-rearm$1
(syntax-track-origin$1
(datum->syntax$1
disarmed-s_0
(cons alternate-id_0 (cdr (syntax-e$1 disarmed-s_0)))
s_0)
s_0)
s_0))))))
(define register-variable-referenced-if-local!
(lambda (binding_0 ctx_0)
(if (if (local-binding? binding_0)
(if (reference-record? (binding-frame-id binding_0))
(not
(begin-unsafe
(expand-context/inner-parsing-expanded?
(root-expand-context/outer-inner ctx_0))))
#f)
#f)
(let ((app_0 (binding-frame-id binding_0)))
(reference-record-used! app_0 (local-binding-key binding_0)))
(void))))
(define expand/capture-lifts.1
(|#%name|
expand/capture-lifts
(lambda (always-wrap?54_0
begin-form?52_0
expand-lifts?51_0
lift-key53_0
s59_0
ctx60_0)
(begin
(let ((lift-key_0
(if (eq? lift-key53_0 unsafe-undefined)
(generate-lift-key)
lift-key53_0)))
(let ((context_0
(begin-unsafe (expand-context/outer-context ctx60_0))))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx60_0)))))
(let ((local?_0 (not begin-form?52_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_0 always-wrap?_0 ctx_0)
(begin
(let ((lift-env_0 (if local?_0 (box empty-env) #f)))
(let ((lift-ctx_0
(let ((temp193_0
(if local?_0
(make-local-lift
lift-env_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
ctx_0)))
(if (begin-unsafe
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner
ctx_0)))
'lift
#f))
(make-top-level-lift ctx_0))))
(let ((temp194_0
(if (not local?_0)
(eq? context_0 'module)
#f)))
(let ((temp193_1 temp193_0))
(make-lift-context.1
temp194_0
temp193_1))))))
(let ((capture-ctx_0
(if (expand-context/outer? 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
(if local?_0
(cons
lift-env_0
(begin-unsafe
(expand-context/inner-lift-envs
(root-expand-context/outer-inner
ctx_0))))
(begin-unsafe
(expand-context/inner-lift-envs
(root-expand-context/outer-inner
ctx_0))))))
(let ((module-lifts199_0
(if (if local?_0
local?_0
(not
(memq
context_0
'(top-level
module))))
(begin-unsafe
(expand-context/inner-module-lifts
(root-expand-context/outer-inner
ctx_0)))
lift-ctx_0)))
(let ((lift-envs198_1
lift-envs198_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))))
(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?"
ctx_0))))
(let ((rebuild-s_0 (keep-properties-only s_0)))
(let ((exp-s_0
(expand.1 #f #f s_0 capture-ctx_0)))
(let ((lifts_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_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|
expand-transformer
(lambda (always-wrap?66_0
begin-form?63_0
context62_0
expand-lifts?64_0
keep-stops?67_0
lift-key65_0
s74_0
ctx75_0)
(begin
(let ((lift-key_0
(if (eq? lift-key65_0 unsafe-undefined)
(generate-lift-key)
lift-key65_0)))
(begin
(if log-performance?
(start-performance-region 'expand 'transformer)
(void))
(begin0
(let ((trans-ctx_0
(context->transformer-context.1
keep-stops?67_0
ctx75_0
context62_0)))
(expand/capture-lifts.1
always-wrap?66_0
begin-form?63_0
expand-lifts?64_0
lift-key_0
s74_0
trans-ctx_0))
(if log-performance? (end-performance-region) (void)))))))))
(define context->transformer-context.1
(|#%name|
context->transformer-context
(lambda (keep-stops?77_0 ctx80_0 context79_0)
(begin
(let ((phase_0
(add1
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx80_0))))))
(let ((ns_0
(namespace->namespace-at-phase
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx80_0)))
phase_0)))
(begin
(namespace-visit-available-modules! ns_0 phase_0)
(if (expand-context/outer? ctx80_0)
(let ((only-immediate?217_0
(if keep-stops?77_0
(begin-unsafe
(expand-context/outer-only-immediate? ctx80_0))
#f)))
(let ((inner220_0
(let ((the-struct_0
(root-expand-context/outer-inner ctx80_0)))
(if (expand-context/inner? the-struct_0)
(let ((stops223_0
(if keep-stops?77_0
(begin-unsafe
(expand-context/inner-stops
(root-expand-context/outer-inner
ctx80_0)))
empty-free-id-set)))
(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))
(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?"
ctx80_0)))))))))
(define expand+eval-for-syntaxes-binding.1
(|#%name|
expand+eval-for-syntaxes-binding
(lambda (log-next?82_0 who84_0 rhs85_0 ids86_0 ctx87_0)
(begin
(let ((exp-rhs_0
(let ((temp225_0 (as-named-context ctx87_0 ids86_0)))
(expand-transformer.1
#f
#f
'expression
#t
#f
unsafe-undefined
rhs85_0
temp225_0))))
(let ((phase_0
(add1
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx87_0))))))
(let ((parsed-rhs_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx87_0)))
exp-rhs_0
(let ((temp227_0
(let ((temp228_0 (as-to-parsed-context ctx87_0)))
(context->transformer-context.1
#f
temp228_0
'expression))))
(expand.1 #f #f exp-rhs_0 temp227_0)))))
(begin
(if log-next?82_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx87_0)))))
(if obs_0 (call-expand-observe obs_0 'next) (void)))
(void))
(values
exp-rhs_0
parsed-rhs_0
(eval-for-bindings
who84_0
ids86_0
parsed-rhs_0
phase_0
(namespace->namespace-at-phase
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx87_0)))
phase_0)
ctx87_0))))))))))
(define eval-for-syntaxes-binding
(lambda (who_0 rhs_0 ids_0 ctx_0)
(call-with-values
(lambda ()
(expand+eval-for-syntaxes-binding.1 #t who_0 rhs_0 ids_0 ctx_0))
(case-lambda
((exp-rhs_0 parsed-rhs_0 vals_0) vals_0)
(args (raise-binding-result-arity-error 3 args))))))
(define eval-for-bindings
(lambda (who_0 ids_0 p_0 phase_0 ns_0 ctx_0)
(let ((compiled_0
(if (can-direct-eval?
p_0
ns_0
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner ctx_0))))
#f
(compile-single
p_0
(make-compile-context.1
#f
unsafe-undefined
#f
ns_0
phase_0
unsafe-undefined)))))
(let ((vals_0
(call-with-values
(lambda ()
(call-with-continuation-barrier
(lambda ()
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
ns_0
eval-jit-enabled
#f)
(with-continuation-mark*
authentic
current-expand-context
ctx_0
(if compiled_0
(eval-single-top compiled_0 ns_0)
(direct-eval
p_0
ns_0
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner ctx_0))))))))))
list)))
(begin
(if (let ((app_0 (length vals_0))) (= app_0 (length ids_0)))
(void)
(let ((app_0 (length ids_0)))
(apply
raise-result-arity-error
who_0
app_0
(if (null? ids_0)
""
(let ((app_1 (syntax-e$1 (car ids_0))))
(format
"\n in: definition of ~a~a"
app_1
(if (pair? (cdr ids_0)) " ..." ""))))
vals_0)))
vals_0)))))
(define keep-properties-only
(lambda (s_0) (datum->syntax$1 #f 'props s_0 s_0)))
(define keep-properties-only~ (lambda (s_0) #f))
(define keep-as-needed.1
(|#%name|
keep-as-needed
(lambda (for-track?89_0
keep-for-error?91_0
keep-for-parsed?90_0
ctx95_0
s96_0)
(begin
(let ((d_0 (syntax-e/no-taint s96_0)))
(let ((keep-e_0
(if (symbol? d_0)
d_0
(if (if (pair? d_0)
(let ((s_0 (car d_0)))
(begin-unsafe (symbol? (syntax-content s_0))))
#f)
(syntax-e$1 (car d_0))
#f))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx95_0)))
(if (if keep-for-parsed?90_0
keep-for-parsed?90_0
keep-for-error?91_0)
(datum->syntax$1 #f keep-e_0 s96_0 s96_0)
#f)
(if (if for-track?89_0 (if (pair? d_0) keep-e_0 #f) #f)
(datum->syntax$1 #f (list (car d_0)) s96_0 s96_0)
(syntax-rearm$1
(datum->syntax$1 (syntax-disarm$1 s96_0) keep-e_0 s96_0 s96_0)
s96_0)))))))))
(define attach-disappeared-transformer-bindings
(lambda (s_0 trans-idss_0)
(if (null? trans-idss_0)
s_0
(syntax-property$1
s_0
'disappeared-binding
(let ((app_0 (apply append trans-idss_0)))
(append
app_0
(let ((or-part_0 (syntax-property$1 s_0 'disappeared-binding)))
(if or-part_0 or-part_0 null))))))))
(define increment-binding-layer
(lambda (ids_0 ctx_0 layer-val_0)
(if (letrec*
((loop_0
(|#%name|
loop
(lambda (ids_1)
(begin
(let ((or-part_0 (identifier? ids_1)))
(if or-part_0
or-part_0
(if (pair? ids_1)
(let ((or-part_1 (loop_0 (car ids_1))))
(if or-part_1 or-part_1 (loop_0 (cdr ids_1))))
#f))))))))
(loop_0 ids_0))
layer-val_0
(begin-unsafe (expand-context/outer-binding-layer ctx_0)))))
(define wrap-lifts-as-parsed-let
(lambda (lifts_0 exp-s_0 rebuild-s_0 ctx_0 parse-rhs_0)
(let ((idss+keyss+rhss_0 (get-lifts-as-lists lifts_0)))
(letrec*
((lets-loop_0
(|#%name|
lets-loop
(lambda (idss+keyss+rhss_1 rhs-ctx_0)
(begin
(if (null? idss+keyss+rhss_1)
exp-s_0
(let ((ids_0 (caar idss+keyss+rhss_1)))
(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)))
(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
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_0)))
(let ((rest_0
(unsafe-cdr
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 ((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)
(with-continuation-mark*
authentic
current-expand-context
ctx_0
(1/rename-transformer-target t_0))))
(define maybe-install-free=id-in-context!
(lambda (val_0 id_0 phase_0 ctx_0)
(if (1/rename-transformer? val_0)
(with-continuation-mark*
authentic
current-expand-context
ctx_0
(maybe-install-free=id! val_0 id_0 phase_0))
(void))))
(define transfer-srcloc
(lambda (new-s_0 old-s_0)
(let ((srcloc_0 (syntax-srcloc old-s_0)))
(if srcloc_0
(if (syntax?$1 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
(lambda (stop-ids_0 phase_0)
(if (null? stop-ids_0)
stop-ids_0
(let ((p-core-stx_0 (syntax-shift-phase-level$1 core-stx phase_0)))
(if (if (= 1 (length stop-ids_0))
(let ((app_0 (car stop-ids_0)))
(free-identifier=?$1
app_0
(datum->syntax$1 p-core-stx_0 'module*)
phase_0
phase_0))
#f)
stop-ids_0
(append
stop-ids_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((sym_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(datum->syntax$1 p-core-stx_0 sym_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null auto-stop-syms))))))))))
(define auto-stop-syms
'(begin
quote
set!
lambda
case-lambda
let-values
letrec-values
if
begin0
with-continuation-mark
letrec-syntaxes+values
|#%app|
|#%expression|
|#%top|
|#%variable-reference|))
(define module-expand-stop-ids
(lambda (phase_0)
(let ((p-core-stx_0 (syntax-shift-phase-level$1 core-stx phase_0)))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((sym_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(datum->syntax$1 p-core-stx_0 sym_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null module-stop-syms)))))))
(define module-stop-syms
(append
auto-stop-syms
'(define-values
define-syntaxes
begin-for-syntax
|#%require|
|#%provide|
module
module*
|#%declare|
|#%stratified-body|)))
(define struct:internal-definition-context
(make-record-type-descriptor*
'internal-definition-context
#f
(|#%nongenerative-uid| internal-definition-context)
#f
#f
5
0))
(define effect_1896
(struct-type-install-properties!
struct:internal-definition-context
'internal-definition-context
5
0
#f
null
(current-inspector)
#f
'(0 1 2 3 4)
#f
'internal-definition-context))
(define internal-definition-context1.1
(|#%name|
internal-definition-context
(record-constructor
(make-record-constructor-descriptor
struct:internal-definition-context
#f
#f))))
(define 1/internal-definition-context?_2482
(|#%name|
internal-definition-context?
(record-predicate struct:internal-definition-context)))
(define 1/internal-definition-context?
(|#%name|
internal-definition-context?
(lambda (v)
(if (1/internal-definition-context?_2482 v)
#t
($value
(if (impersonator? v)
(1/internal-definition-context?_2482 (impersonator-val v))
#f))))))
(define internal-definition-context-frame-id_2857
(|#%name|
internal-definition-context-frame-id
(record-accessor struct:internal-definition-context 0)))
(define internal-definition-context-frame-id
(|#%name|
internal-definition-context-frame-id
(lambda (s)
(if (1/internal-definition-context?_2482 s)
(internal-definition-context-frame-id_2857 s)
($value
(impersonate-ref
internal-definition-context-frame-id_2857
struct:internal-definition-context
0
s
'internal-definition-context
'frame-id))))))
(define internal-definition-context-scope_1731
(|#%name|
internal-definition-context-scope
(record-accessor struct:internal-definition-context 1)))
(define internal-definition-context-scope
(|#%name|
internal-definition-context-scope
(lambda (s)
(if (1/internal-definition-context?_2482 s)
(internal-definition-context-scope_1731 s)
($value
(impersonate-ref
internal-definition-context-scope_1731
struct:internal-definition-context
1
s
'internal-definition-context
'scope))))))
(define internal-definition-context-add-scope?_2770
(|#%name|
internal-definition-context-add-scope?
(record-accessor struct:internal-definition-context 2)))
(define internal-definition-context-add-scope?
(|#%name|
internal-definition-context-add-scope?
(lambda (s)
(if (1/internal-definition-context?_2482 s)
(internal-definition-context-add-scope?_2770 s)
($value
(impersonate-ref
internal-definition-context-add-scope?_2770
struct:internal-definition-context
2
s
'internal-definition-context
'add-scope?))))))
(define internal-definition-context-env-mixins_2849
(|#%name|
internal-definition-context-env-mixins
(record-accessor struct:internal-definition-context 3)))
(define internal-definition-context-env-mixins
(|#%name|
internal-definition-context-env-mixins
(lambda (s)
(if (1/internal-definition-context?_2482 s)
(internal-definition-context-env-mixins_2849 s)
($value
(impersonate-ref
internal-definition-context-env-mixins_2849
struct:internal-definition-context
3
s
'internal-definition-context
'env-mixins))))))
(define internal-definition-context-parent-ctx_1685
(|#%name|
internal-definition-context-parent-ctx
(record-accessor struct:internal-definition-context 4)))
(define internal-definition-context-parent-ctx
(|#%name|
internal-definition-context-parent-ctx
(lambda (s)
(if (1/internal-definition-context?_2482 s)
(internal-definition-context-parent-ctx_1685 s)
($value
(impersonate-ref
internal-definition-context-parent-ctx_1685
struct:internal-definition-context
4
s
'internal-definition-context
'parent-ctx))))))
(define struct:env-mixin
(make-record-type-descriptor*
'env-mixin
#f
(|#%nongenerative-uid| env-mixin)
#f
#f
4
0))
(define effect_2815
(struct-type-install-properties!
struct:env-mixin
'env-mixin
4
0
#f
null
(current-inspector)
#f
'(0 1 2 3)
#f
'env-mixin))
(define env-mixin2.1
(|#%name|
env-mixin
(record-constructor
(make-record-constructor-descriptor struct:env-mixin #f #f))))
(define env-mixin?_2685
(|#%name| env-mixin? (record-predicate struct:env-mixin)))
(define env-mixin?
(|#%name|
env-mixin?
(lambda (v)
(if (env-mixin?_2685 v)
#t
($value
(if (impersonator? v) (env-mixin?_2685 (impersonator-val v)) #f))))))
(define env-mixin-id_3169
(|#%name| env-mixin-id (record-accessor struct:env-mixin 0)))
(define env-mixin-id
(|#%name|
env-mixin-id
(lambda (s)
(if (env-mixin?_2685 s)
(env-mixin-id_3169 s)
($value
(impersonate-ref
env-mixin-id_3169
struct:env-mixin
0
s
'env-mixin
'id))))))
(define env-mixin-sym_1834
(|#%name| env-mixin-sym (record-accessor struct:env-mixin 1)))
(define env-mixin-sym
(|#%name|
env-mixin-sym
(lambda (s)
(if (env-mixin?_2685 s)
(env-mixin-sym_1834 s)
($value
(impersonate-ref
env-mixin-sym_1834
struct:env-mixin
1
s
'env-mixin
'sym))))))
(define env-mixin-value_2403
(|#%name| env-mixin-value (record-accessor struct:env-mixin 2)))
(define env-mixin-value
(|#%name|
env-mixin-value
(lambda (s)
(if (env-mixin?_2685 s)
(env-mixin-value_2403 s)
($value
(impersonate-ref
env-mixin-value_2403
struct:env-mixin
2
s
'env-mixin
'value))))))
(define env-mixin-cache_2675
(|#%name| env-mixin-cache (record-accessor struct:env-mixin 3)))
(define env-mixin-cache
(|#%name|
env-mixin-cache
(lambda (s)
(if (env-mixin?_2685 s)
(env-mixin-cache_2675 s)
($value
(impersonate-ref
env-mixin-cache_2675
struct:env-mixin
3
s
'env-mixin
'cache))))))
(define 1/syntax-local-make-definition-context
(let ((syntax-local-make-definition-context_0
(|#%name|
syntax-local-make-definition-context
(lambda (parent-ctx3_0 add-scope?4_0)
(begin
(begin
(if (let ((or-part_0 (not parent-ctx3_0)))
(if or-part_0
or-part_0
(1/internal-definition-context? parent-ctx3_0)))
(void)
(raise-argument-error
'syntax-local-make-definition-context
"(or/c #f internal-definition-context?)"
parent-ctx3_0))
(let ((ctx_0
(get-current-expand-context.1
#f
'syntax-local-make-definition-context)))
(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
(if parent-ctx3_0
(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)))))))))))))
(|#%name|
syntax-local-make-definition-context
(case-lambda
(() (begin (syntax-local-make-definition-context_0 #f #t)))
((parent-ctx_0 add-scope?4_0)
(syntax-local-make-definition-context_0 parent-ctx_0 add-scope?4_0))
((parent-ctx3_0)
(syntax-local-make-definition-context_0 parent-ctx3_0 #t))))))
(define 1/syntax-local-bind-syntaxes
(let ((syntax-local-bind-syntaxes_0
(|#%name|
syntax-local-bind-syntaxes
(lambda (ids6_0 s7_0 intdef8_0 extra-intdefs5_0)
(begin
(begin
(if (if (list? ids6_0) (andmap_2344 identifier? ids6_0) #f)
(void)
(raise-argument-error
'syntax-local-bind-syntaxes
"(listof identifier?)"
ids6_0))
(begin
(if (let ((or-part_0 (not s7_0)))
(if or-part_0 or-part_0 (syntax?$1 s7_0)))
(void)
(raise-argument-error
'syntax-local-bind-syntaxes
"(or/c syntax? #f)"
s7_0))
(begin
(if (1/internal-definition-context? intdef8_0)
(void)
(raise-argument-error
'syntax-local-bind-syntaxes
"internal-definition-context?"
intdef8_0))
(begin
(if (intdefs? extra-intdefs5_0)
(void)
(raise-argument-error
'syntax-local-bind-syntaxes
intdefs?-string
extra-intdefs5_0))
(let ((ctx_0
(get-current-expand-context.1 #f 'local-expand)))
(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 'local-bind ids6_0)
(void)))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((all-intdefs_0
(if (list? extra-intdefs5_0)
(cons intdef8_0 extra-intdefs5_0)
(list intdef8_0 extra-intdefs5_0))))
(let ((intdef-ids_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((pre-id_0
(remove-use-site-scopes
(begin-unsafe
(flip-scopes
id_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0))))
ctx_0)))
(let ((temp39_0
(add-intdef-scopes.1
unsafe-undefined
#t
pre-id_0
intdef8_0)))
(add-intdef-scopes.1
unsafe-undefined
#f
temp39_0
extra-intdefs5_0)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null ids6_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
'rename-list
intdef-ids_0)
(void)))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
ctx_0)))))
(let ((local-sym_0
(if (begin-unsafe
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner
ctx_0)))
'loc
#f)))
(let ((syms_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((intdef-id_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((temp47_0
(internal-definition-context-frame-id
intdef8_0)))
(add-local-binding!.1
temp47_0
#f
local-sym_0
intdef-id_0
phase_0
counter_0))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
intdef-ids_0))))))
(let ((local-ctx_0
(if s7_0
(let ((tmp-env_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 ((sym_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((intdef-id_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((val_0
(local-variable1.1
intdef-id_0)))
(let ((env_1
(let ((env_1
(begin-unsafe
(hash-set
env_0
sym_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
ctx_0))
syms_0
intdef-ids_0)))))
(let ((temp49_0
(if (expand-context/outer?
ctx_0)
(let ((inner53_0
(root-expand-context/outer-inner
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?"
ctx_0))))
(make-local-expand-context.1
'expression
all-intdefs_0
#t
unsafe-undefined
#f
#f
#f
temp49_0)))
#f)))
(let ((vals_0
(if s7_0
(let ((input-s_0
(let ((s_0
(add-intdef-scopes.1
unsafe-undefined
#f
s7_0
all-intdefs_0)))
(begin-unsafe
(flip-scopes
s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_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
'enter-bind)
(void)))
(let ((vals_0
(eval-for-syntaxes-binding
'syntax-local-bind-syntaxes
input-s_0
ids6_0
local-ctx_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
'exit-bind)
(void)))
vals_0))))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair? lst_0)
(let ((intdef-id_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(cons
(local-variable1.1
intdef-id_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
intdef-ids_0)))))))
(let ((env-mixins_0
(internal-definition-context-env-mixins
intdef8_0)))
(begin
(set-box!
env-mixins_0
(let ((app_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0
lst_1
lst_2)
(begin
(if (if (pair?
lst_0)
(if (pair?
lst_1)
(pair?
lst_2)
#f)
#f)
(let ((intdef-id_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((sym_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((val_0
(unsafe-car
lst_2)))
(let ((rest_2
(unsafe-cdr
lst_2)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin
(if local-ctx_0
(maybe-install-free=id-in-context!
val_0
intdef-id_0
phase_0
local-ctx_0)
(void))
(env-mixin2.1
intdef-id_0
sym_0
val_0
(make-weak-hasheq)))
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
intdef-ids_0
syms_0
vals_0))))))
(append
app_0
(unbox env-mixins_0))))
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-local-bind)
(void)))))))))))))))))))))))))
(|#%name|
syntax-local-bind-syntaxes
(case-lambda
((ids_0 s_0 intdef_0)
(begin (syntax-local-bind-syntaxes_0 ids_0 s_0 intdef_0 '())))
((ids_0 s_0 intdef_0 extra-intdefs5_0)
(syntax-local-bind-syntaxes_0 ids_0 s_0 intdef_0 extra-intdefs5_0))))))
(define 1/internal-definition-context-binding-identifiers
(|#%name|
internal-definition-context-binding-identifiers
(lambda (intdef_0)
(begin
(begin
(if (1/internal-definition-context? intdef_0)
(void)
(raise-argument-error
'internal-definition-context-binding-identifiers
"internal-definition-context?"
intdef_0))
(reverse$1
(let ((lst_0
(unbox (internal-definition-context-env-mixins intdef_0))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(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))))
fold-var_0))))))
(for-loop_0 null lst_0))))))))))
(define 1/internal-definition-context-introduce
(let ((internal-definition-context-introduce_0
(|#%name|
internal-definition-context-introduce
(lambda (intdef10_0 s11_0 mode9_0)
(begin
(begin
(if (1/internal-definition-context? intdef10_0)
(void)
(raise-argument-error
'internal-definition-context-introduce
"internal-definition-context?"
intdef10_0))
(begin
(if (syntax?$1 s11_0)
(void)
(raise-argument-error
'internal-definition-context-introduce
"syntax?"
s11_0))
(let ((new-s_0
(let ((temp59_0
(if (eq? mode9_0 'add)
add-scope
(if (eq? mode9_0 'remove)
remove-scope
(if (eq? mode9_0 'flip)
flip-scope
(raise-argument-error
'internal-definition-context-introduce
"(or/c 'add 'remove 'flip)"
mode9_0))))))
(add-intdef-scopes.1
temp59_0
#t
s11_0
intdef10_0))))
(let ((ctx_0
(get-current-expand-context.1 #t 'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'internal-definition-context-introduce
new-s_0
s11_0)
(void)))
(void))
new-s_0))))))))))
(|#%name|
internal-definition-context-introduce
(case-lambda
((intdef_0 s_0)
(begin (internal-definition-context-introduce_0 intdef_0 s_0 'flip)))
((intdef_0 s_0 mode9_0)
(internal-definition-context-introduce_0 intdef_0 s_0 mode9_0))))))
(define 1/internal-definition-context-seal
(|#%name|
internal-definition-context-seal
(lambda (intdef_0)
(begin
(begin
(if (1/internal-definition-context? intdef_0)
(void)
(raise-argument-error
'internal-definition-context-seal
"internal-definition-context?"
intdef_0))
(void))))))
(define 1/identifier-remove-from-definition-context
(|#%name|
identifier-remove-from-definition-context
(lambda (id_0 intdef_0)
(begin
(begin
(if (identifier? id_0)
(void)
(raise-argument-error
'identifier-remove-from-definition-context
"identifier?"
id_0))
(if (let ((or-part_0 (1/internal-definition-context? intdef_0)))
(if or-part_0
or-part_0
(if (list? intdef_0)
(andmap_2344 1/internal-definition-context? intdef_0)
#f)))
(void)
(raise-argument-error
'identifier-remove-from-definition-context
"(or/c internal-definition-context? (listof internal-definition-context?))"
intdef_0))
(let ((x_0
(if (list? intdef_0)
(reverse$1 intdef_0)
(if (not intdef_0) null (list intdef_0)))))
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (id_1 a_0)
(begin
(if (pair? a_0)
(let ((intdef_1 (car a_0)))
(let ((id_2
(let ((id_2
(1/internal-definition-context-introduce
intdef_1
id_1
'remove)))
(values id_2))))
(for-loop_0 id_2 (cdr a_0))))
id_1))))))
(for-loop_0 id_0 x_0)))))))))
(define intdefs?
(lambda (x_0)
(let ((or-part_0 (1/internal-definition-context? x_0)))
(if or-part_0
or-part_0
(if (list? x_0)
(andmap_2344 1/internal-definition-context? x_0)
#f)))))
(define intdefs?-string
"(or/c internal-definition-context? (listof internal-definition-context?))")
(define intdefs-or-false?
(lambda (x_0)
(let ((or-part_0 (not x_0))) (if or-part_0 or-part_0 (intdefs? x_0)))))
(define intdefs-or-false?-string
"(or/c internal-definition-context? (listof internal-definition-context?) #f)")
(define add-intdef-bindings
(lambda (env_0 intdefs_0)
(let ((x_0
(if (list? intdefs_0)
(reverse$1 intdefs_0)
(if (not intdefs_0) null (list intdefs_0)))))
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (env_1 a_0)
(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-env_0
(if parent-ctx_0
(add-intdef-bindings
env_1
parent-ctx_0)
env_1)))
(let ((env-mixins_0
(unbox
(internal-definition-context-env-mixins
intdef_0))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (env_2 env-mixins_1)
(begin
(if (null? env-mixins_1)
env_2
(let ((env-mixin_0
(car env-mixins_1)))
(let ((or-part_0
(hash-ref
(env-mixin-cache
env-mixin_0)
env_2
#f)))
(if or-part_0
or-part_0
(let ((new-env_0
(let ((env_3
(loop_0
env_2
(cdr
env-mixins_1))))
(let ((key_0
(env-mixin-sym
env-mixin_0)))
(let ((val_0
(env-mixin-value
env-mixin_0)))
(let ((key_1
key_0)
(env_4
env_3))
(begin-unsafe
(hash-set
env_4
key_1
val_0))))))))
(begin
(hash-set!
(env-mixin-cache
env-mixin_0)
env_2
new-env_0)
new-env_0)))))))))))
(loop_0
parent-env_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
(|#%name|
add-intdef-scopes
(lambda (action13_0 always?12_0 s16_0 intdefs17_0)
(begin
(let ((action_0
(if (eq? action13_0 unsafe-undefined) add-scope action13_0)))
(let ((x_0
(if (list? intdefs17_0)
(reverse$1 intdefs17_0)
(if (not intdefs17_0) null (list intdefs17_0)))))
(begin
#t
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_0 a_0)
(begin
(if (pair? a_0)
(let ((intdef_0 (car a_0)))
(let ((s_1
(if (if always?12_0
always?12_0
(internal-definition-context-add-scope?
intdef_0))
(let ((s_1
(|#%app|
action_0
s_0
(internal-definition-context-scope
intdef_0))))
(values s_1))
s_0)))
(for-loop_0 s_1 (cdr a_0))))
s_0))))))
(for-loop_0 s16_0 x_0)))))))))
(define make-local-expand-context.1
(|#%name|
make-local-expand-context
(lambda (context19_0
intdefs21_0
|keep-#%expression?25_0|
phase20_0
stop-ids22_0
to-parsed-ok?23_0
track-to-be-defined?24_0
ctx33_0)
(begin
(let ((phase_0
(if (eq? phase20_0 unsafe-undefined)
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx33_0)))
phase20_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_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 ((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)
#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_1
(pair? context19_0)))
(if or-part_1
or-part_1
(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
(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
s_0
(begin-unsafe (expand-context/outer-current-introduction-scopes ctx_0)))))
(define flip-introduction-and-use-scopes
(lambda (s_0 ctx_0)
(flip-scopes
(begin-unsafe
(flip-scopes
s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes ctx_0))))
(begin-unsafe (expand-context/outer-current-use-scopes ctx_0)))))
(define 1/syntax-transforming?
(|#%name|
syntax-transforming?
(lambda ()
(begin (if (get-current-expand-context.1 #t 'unexpected) #t #f)))))
(define 1/syntax-transforming-with-lifts?
(|#%name|
syntax-transforming-with-lifts?
(lambda ()
(begin
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(if ctx_0
(if (begin-unsafe
(expand-context/inner-lifts
(root-expand-context/outer-inner ctx_0)))
#t
#f)
#f))))))
(define 1/syntax-transforming-module-expression?
(|#%name|
syntax-transforming-module-expression?
(lambda ()
(begin
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(if ctx_0
(if (begin-unsafe
(expand-context/inner-to-module-lifts
(root-expand-context/outer-inner ctx_0)))
#t
#f)
#f))))))
(define 1/syntax-local-transforming-module-provides?
(|#%name|
syntax-local-transforming-module-provides?
(lambda ()
(begin
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(if ctx_0
(if (begin-unsafe
(expand-context/inner-requires+provides
(root-expand-context/outer-inner ctx_0)))
#t
#f)
#f))))))
(define 1/syntax-local-context
(|#%name|
syntax-local-context
(lambda ()
(begin
(let ((ctx_0 (get-current-expand-context.1 #f 'syntax-local-context)))
(begin-unsafe (expand-context/outer-context ctx_0)))))))
(define 1/syntax-local-introduce
(|#%name|
syntax-local-introduce
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-local-introduce "syntax?" s_0))
(let ((ctx_0
(get-current-expand-context.1 #f 'syntax-local-introduce)))
(let ((new-s_0 (flip-introduction-and-use-scopes s_0 ctx_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
'track-syntax
'syntax-local-introduce
new-s_0
s_0)
(void)))
new-s_0))))))))
(define 1/syntax-local-identifier-as-binding
(|#%name|
syntax-local-identifier-as-binding
(lambda (id_0)
(begin
(begin
(if (identifier? id_0)
(void)
(raise-argument-error
'syntax-local-identifier-as-binding
"identifier?"
id_0))
(let ((ctx_0
(get-current-expand-context.1
#f
'syntax-local-identifier-as-binding)))
(let ((new-id_0 (remove-use-site-scopes id_0 ctx_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
'track-syntax
'syntax-local-identifier-as-binding
new-id_0
id_0)
(void)))
new-id_0))))))))
(define 1/syntax-local-phase-level
(|#%name|
syntax-local-phase-level
(lambda ()
(begin
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(if ctx_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))
0))))))
(define 1/syntax-local-name
(|#%name|
syntax-local-name
(lambda ()
(begin
(let ((ctx_0 (get-current-expand-context.1 #f 'syntax-local-name)))
(let ((id_0 (begin-unsafe (expand-context/outer-name ctx_0))))
(if id_0 (datum->syntax$1 #f (syntax-e$1 id_0) id_0) #f)))))))
(define 1/make-syntax-introducer
(let ((make-syntax-introducer_0
(|#%name|
make-syntax-introducer
(lambda (as-use-site?1_0)
(begin
(do-make-syntax-introducer
(new-scope (if as-use-site?1_0 'use-site 'macro))))))))
(|#%name|
make-syntax-introducer
(case-lambda
(() (begin (make-syntax-introducer_0 #f)))
((as-use-site?1_0) (make-syntax-introducer_0 as-use-site?1_0))))))
(define 1/make-interned-syntax-introducer
(|#%name|
make-interned-syntax-introducer
(lambda (sym-key_0)
(begin
(begin
(if (symbol? sym-key_0)
(void)
(raise-argument-error
'make-interned-syntax-introducer
"symbol?"
sym-key_0))
(do-make-syntax-introducer (make-interned-scope sym-key_0)))))))
(define do-make-syntax-introducer
(lambda (sc_0)
(let ((do-make-syntax-introducer_0
(|#%name|
do-make-syntax-introducer
(lambda (s57_0 mode56_0)
(begin
(begin
(if (syntax?$1 s57_0)
(void)
(raise-argument-error 'syntax-introducer "syntax?" s57_0))
(let ((new-s_0
(if (eq? mode56_0 'add)
(add-scope s57_0 sc_0)
(if (eq? mode56_0 'remove)
(remove-scope s57_0 sc_0)
(if (eq? mode56_0 'flip)
(flip-scope s57_0 sc_0)
(raise-argument-error
'syntax-introducer
"(or/c 'add 'remove 'flip)"
mode56_0))))))
(let ((ctx_0
(get-current-expand-context.1 #t 'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
mode56_0
new-s_0
s57_0)
(void)))
(void))
new-s_0)))))))))
(|#%name|
do-make-syntax-introducer
(case-lambda
((s_0) (begin (do-make-syntax-introducer_0 s_0 'flip)))
((s_0 mode56_0) (do-make-syntax-introducer_0 s_0 mode56_0)))))))
(define 1/make-syntax-delta-introducer
(let ((make-syntax-delta-introducer_0
(|#%name|
make-syntax-delta-introducer
(lambda (ext-s3_0 base-s4_0 phase2_0)
(begin
(let ((phase_0
(if (eq? phase2_0 unsafe-undefined)
(1/syntax-local-phase-level)
phase2_0)))
(begin
(if (syntax?$1 ext-s3_0)
(void)
(raise-argument-error
'make-syntax-delta-introducer
"syntax?"
ext-s3_0))
(begin
(if (let ((or-part_0 (not base-s4_0)))
(if or-part_0 or-part_0 (syntax?$1 base-s4_0)))
(void)
(raise-argument-error
'make-syntax-delta-introducer
"(or/c syntax? #f)"
base-s4_0))
(begin
(if (phase? phase_0)
(void)
(raise-argument-error
'make-syntax-delta-introducer
phase?-string
phase_0))
(let ((ext-scs_0 (syntax-scope-set ext-s3_0 phase_0)))
(let ((base-scs_0
(syntax-scope-set
(if base-s4_0 base-s4_0 empty-syntax)
phase_0)))
(let ((use-base-scs_0
(if (begin-unsafe
(hash-keys-subset? base-scs_0 ext-scs_0))
base-scs_0
(let ((or-part_0
(if (identifier? base-s4_0)
(resolve.1
#f
#f
null
#t
base-s4_0
phase_0)
#f)))
(if or-part_0 or-part_0 (seteq))))))
(let ((delta-scs_0
(set->list
(set-subtract ext-scs_0 use-base-scs_0))))
(let ((maybe-taint_0
(if (begin-unsafe
(let ((v_0 (syntax-tamper ext-s3_0)))
(begin-unsafe (not v_0))))
values
syntax-taint$1)))
(let ((shifts_0 (syntax-mpi-shifts ext-s3_0)))
(let ((make-syntax-delta-introducer_0
(|#%name|
make-syntax-delta-introducer
(lambda (s64_0 mode63_0)
(begin
(let ((new-s_0
(|#%app|
maybe-taint_0
(if (eq? mode63_0 'add)
(let ((temp65_0
(add-scopes
s64_0
delta-scs_0)))
(syntax-add-shifts.1
#t
temp65_0
shifts_0
#f))
(if (eq?
mode63_0
'remove)
(remove-scopes
s64_0
delta-scs_0)
(if (eq?
mode63_0
'flip)
(let ((temp68_0
(flip-scopes
s64_0
delta-scs_0)))
(syntax-add-shifts.1
#t
temp68_0
shifts_0
#f))
(raise-argument-error
'syntax-introducer
"(or/c 'add 'remove 'flip)"
mode63_0)))))))
(let ((ctx_0
(get-current-expand-context.1
#t
'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
mode63_0
new-s_0
s64_0)
(void)))
(void))
new-s_0))))))))
(|#%name|
make-syntax-delta-introducer
(case-lambda
((s_0)
(begin
(make-syntax-delta-introducer_0
s_0
'add)))
((s_0 mode63_0)
(make-syntax-delta-introducer_0
s_0
mode63_0))))))))))))))))))))
(|#%name|
make-syntax-delta-introducer
(case-lambda
((ext-s_0 base-s_0)
(begin
(make-syntax-delta-introducer_0 ext-s_0 base-s_0 unsafe-undefined)))
((ext-s_0 base-s_0 phase2_0)
(make-syntax-delta-introducer_0 ext-s_0 base-s_0 phase2_0))))))
(define 1/syntax-local-make-delta-introducer
(|#%name|
syntax-local-make-delta-introducer
(lambda (id-stx_0)
(begin
(begin
(if (identifier? id-stx_0)
(void)
(raise-argument-error
'syntax-local-make-delta-introducer
"identifier?"
id-stx_0))
(raise
(|#%app|
exn:fail:unsupported
"syntax-local-make-delta-introducer: not supported anymore"
(current-continuation-marks))))))))
(define do-syntax-local-value.1
(|#%name|
do-syntax-local-value
(lambda (immediate?5_0 who7_0 id8_0 intdefs9_0 failure-thunk10_0)
(begin
(begin
(if (identifier? id8_0)
(void)
(raise-argument-error who7_0 "identifier?" id8_0))
(begin
(if (let ((or-part_0 (not failure-thunk10_0)))
(if or-part_0
or-part_0
(if (procedure? failure-thunk10_0)
(procedure-arity-includes? failure-thunk10_0 0)
#f)))
(void)
(raise-argument-error
who7_0
"(or/c #f (procedure-arity-includes/c 0))"
failure-thunk10_0))
(begin
(if (intdefs-or-false? intdefs9_0)
(void)
(raise-argument-error
who7_0
intdefs-or-false?-string
intdefs9_0))
(let ((current-ctx_0 (get-current-expand-context.1 #f who7_0)))
(let ((ctx_0
(if intdefs9_0
(if (expand-context/outer? current-ctx_0)
(let ((env74_0
(add-intdef-bindings
(begin-unsafe
(expand-context/outer-env current-ctx_0))
intdefs9_0)))
(let ((inner75_0
(root-expand-context/outer-inner
current-ctx_0)))
(let ((env74_1 env74_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?"
current-ctx_0))
current-ctx_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 'local-value id8_0)
(void)))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (id_0)
(begin
(let ((b_0
(if immediate?5_0
(resolve+shift.1
#f
#f
null
#t
#f
id_0
phase_0)
(resolve+shift/extra-inspector
id_0
phase_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner
ctx_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 (not b_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
'local-value-result
#f)
(void)))
(if failure-thunk10_0
(|#%app| failure-thunk10_0)
(error
who7_0
"unbound identifier: ~v"
id_0)))
(call-with-values
(lambda () (lookup.1 #f #t b_0 ctx_0 id_0))
(case-lambda
((v_0 primitive?_0 insp_0 protected?_0)
(if (let ((or-part_0 (variable? v_0)))
(if or-part_0
or-part_0
(core-form? v_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
'local-value-result
#f)
(void)))
(if failure-thunk10_0
(|#%app| failure-thunk10_0)
(error
who7_0
"identifier is not bound to syntax: ~v"
id_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx_0)))))
(if obs_0
(if (not
(if (1/rename-transformer?
v_0)
(not immediate?5_0)
#f))
(call-expand-observe
obs_0
'local-value-result
#t)
(void))
(void)))
(if (1/rename-transformer? v_0)
(if immediate?5_0
(values
v_0
(rename-transformer-target-in-context
v_0
ctx_0))
(loop_0
(rename-transformer-target-in-context
v_0
ctx_0)))
(if immediate?5_0
(values v_0 #f)
v_0)))))
(args
(raise-binding-result-arity-error
4
args))))))))))))
(loop_0
(begin-unsafe
(flip-scopes
id8_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0)))))))))))))))))
(define 1/syntax-local-value
(let ((syntax-local-value_0
(|#%name|
syntax-local-value
(lambda (id14_0 failure-thunk12_0 intdef13_0)
(begin
(do-syntax-local-value.1
#f
'syntax-local-value
id14_0
intdef13_0
failure-thunk12_0))))))
(|#%name|
syntax-local-value
(case-lambda
((id_0) (begin (syntax-local-value_0 id_0 #f #f)))
((id_0 failure-thunk_0 intdef13_0)
(syntax-local-value_0 id_0 failure-thunk_0 intdef13_0))
((id_0 failure-thunk12_0)
(syntax-local-value_0 id_0 failure-thunk12_0 #f))))))
(define 1/syntax-local-value/immediate
(let ((syntax-local-value/immediate_0
(|#%name|
syntax-local-value/immediate
(lambda (id17_0 failure-thunk15_0 intdef16_0)
(begin
(do-syntax-local-value.1
#t
'syntax-local-value/immediate
id17_0
intdef16_0
failure-thunk15_0))))))
(|#%name|
syntax-local-value/immediate
(case-lambda
((id_0) (begin (syntax-local-value/immediate_0 id_0 #f #f)))
((id_0 failure-thunk_0 intdef16_0)
(syntax-local-value/immediate_0 id_0 failure-thunk_0 intdef16_0))
((id_0 failure-thunk15_0)
(syntax-local-value/immediate_0 id_0 failure-thunk15_0 #f))))))
(define do-lift-values-expression
(lambda (who_0 n_0 s_0)
(begin
(if (syntax?$1 s_0) (void) (raise-argument-error who_0 "syntax?" s_0))
(begin
(if (exact-nonnegative-integer? n_0)
(void)
(raise-argument-error who_0 "exact-nonnegative-integer?" n_0))
(let ((ctx_0 (get-current-expand-context.1 #f who_0)))
(let ((lifts_0
(begin-unsafe
(expand-context/inner-lifts
(root-expand-context/outer-inner ctx_0)))))
(begin
(if lifts_0
(void)
(raise-arguments-error who_0 "no lift target"))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner ctx_0)))))
(let ((ids_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 pos_0)
(begin
(if (< pos_0 n_0)
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin
(set-box!
counter_0
(add1 (unbox counter_0)))
(let ((name_0
(string->unreadable-symbol
(format
"lifted/~a"
(unbox
counter_0)))))
(let ((app_0
(datum->syntax$1
#f
name_0)))
(add-scope
app_0
(new-scope
'macro)))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 (+ pos_0 1)))
fold-var_0))))))
(for-loop_0 null 0))))))
(let ((added-s_0
(begin-unsafe
(flip-scopes
s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_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
'lift-expr
ids_0
s_0
added-s_0)
(void)))
(map_1346
(lambda (id_0)
(begin-unsafe
(flip-scopes
id_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0)))))
(add-lifted!
lifts_0
ids_0
added-s_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner
ctx_0))))))))))))))))
(define 1/syntax-local-lift-expression
(|#%name|
syntax-local-lift-expression
(lambda (s_0)
(begin
(car
(do-lift-values-expression 'syntax-local-lift-expression 1 s_0))))))
(define 1/syntax-local-lift-values-expression
(|#%name|
syntax-local-lift-values-expression
(lambda (n_0 s_0)
(begin
(do-lift-values-expression
'syntax-local-lift-values-expression
n_0
s_0)))))
(define 1/syntax-local-lift-context
(|#%name|
syntax-local-lift-context
(lambda ()
(begin
(let ((ctx_0
(get-current-expand-context.1 #f 'syntax-local-lift-context)))
(begin-unsafe
(root-expand-context/inner-lift-key
(root-expand-context/outer-inner ctx_0))))))))
(define 1/syntax-local-lift-module
(|#%name|
syntax-local-lift-module
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-local-lift-module "syntax?" s_0))
(let ((ctx_0
(get-current-expand-context.1 #f 'syntax-local-lift-module)))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((tmp_0 (core-form-sym s_0 phase_0)))
(if (if (eq? tmp_0 'module) #t (eq? tmp_0 'module*))
(let ((lifts_0
(begin-unsafe
(expand-context/inner-module-lifts
(root-expand-context/outer-inner ctx_0)))))
(begin
(if lifts_0
(void)
(raise-arguments-error
'syntax-local-lift-module
"not currently transforming within a module declaration or top level"
"form to lift"
s_0))
(let ((added-s_0
(begin-unsafe
(flip-scopes
s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0))))))
(begin
(add-lifted-module! lifts_0 added-s_0 phase_0)
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'lift-module
s_0
added-s_0)
(void)))))))
(raise-arguments-error
'syntax-local-lift-module
"not a module form"
"given form"
s_0))))))))))
(define do-local-lift-to-module.1
(|#%name|
do-local-lift-to-module
(lambda (add-lifted!23_0
get-lift-ctx22_0
get-wrt-phase24_0
intro?20_0
log-tag18_0
more-checks21_0
no-target-msg19_0
post-wrap27_0
pre-wrap25_0
shift-wrap26_0
who38_0
s39_0)
(begin
(let ((pre-wrap_0
(if (eq? pre-wrap25_0 unsafe-undefined)
(|#%name|
pre-wrap
(lambda (s_0 phase_0 lift-ctx_0) (begin s_0)))
pre-wrap25_0)))
(let ((shift-wrap_0
(if (eq? shift-wrap26_0 unsafe-undefined)
(|#%name|
shift-wrap
(lambda (s_0 phase_0 lift-ctx_0) (begin s_0)))
shift-wrap26_0)))
(let ((post-wrap_0
(if (eq? post-wrap27_0 unsafe-undefined)
(|#%name|
post-wrap
(lambda (s_0 phase_0 lift-ctx_0) (begin s_0)))
post-wrap27_0)))
(begin
(if (syntax?$1 s39_0)
(void)
(raise-argument-error who38_0 "syntax?" s39_0))
(begin
(|#%app| more-checks21_0)
(let ((ctx_0 (get-current-expand-context.1 #f who38_0)))
(let ((lift-ctx_0 (|#%app| get-lift-ctx22_0 ctx_0)))
(begin
(if lift-ctx_0
(void)
(raise-arguments-error
who38_0
no-target-msg19_0
"form to lift"
s39_0))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((wrt-phase_0
(|#%app| get-wrt-phase24_0 lift-ctx_0)))
(let ((added-s_0
(if intro?20_0
(begin-unsafe
(flip-scopes
s39_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0))))
s39_0)))
(let ((pre-s_0
(|#%app|
pre-wrap_0
added-s_0
phase_0
lift-ctx_0)))
(let ((shift-s_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (s_0 pos_0)
(begin
(if (> pos_0 wrt-phase_0)
(let ((s_1
(let ((s_1
(|#%app|
shift-wrap_0
s_0
(sub1 pos_0)
lift-ctx_0)))
(values s_1))))
(for-loop_0
s_1
(+ pos_0 -1)))
s_0))))))
(for-loop_0 pre-s_0 phase_0)))))
(let ((post-s_0
(|#%app|
post-wrap_0
shift-s_0
wrt-phase_0
lift-ctx_0)))
(begin
(if log-tag18_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
log-tag18_0
s39_0
added-s_0
post-s_0)
(void)))
(void))
(|#%app|
add-lifted!23_0
lift-ctx_0
post-s_0
wrt-phase_0)
(values ctx_0 post-s_0))))))))))))))))))))
(define 1/syntax-local-lift-require
(|#%name|
syntax-local-lift-require
(lambda (s_0 use-s_0)
(begin
(let ((sc_0 (new-scope 'lifted-require)))
(call-with-values
(lambda ()
(let ((temp103_0 (datum->syntax$1 #f s_0)))
(let ((temp104_0 "could not find target context"))
(let ((temp106_0
(lambda ()
(if (syntax?$1 use-s_0)
(void)
(raise-argument-error
'syntax-local-lift-require
"syntax?"
use-s_0)))))
(let ((expand-context-require-lifts107_0
expand-context-require-lifts))
(let ((temp110_0
(lambda (s_1 phase_0 require-lift-ctx_0)
(require-spec-shift-for-syntax s_1))))
(let ((temp111_0
(lambda (s_1 phase_0 require-lift-ctx_0)
(wrap-form
'|#%require|
(add-scope s_1 sc_0)
phase_0))))
(let ((temp110_1 temp110_0)
(expand-context-require-lifts107_1
expand-context-require-lifts107_0)
(temp106_1 temp106_0)
(temp104_1 temp104_0)
(temp103_1 temp103_0))
(do-local-lift-to-module.1
add-lifted-require!
expand-context-require-lifts107_1
require-lift-context-wrt-phase
#f
#f
temp106_1
temp104_1
temp111_0
unsafe-undefined
temp110_1
'syntax-local-lift-require
temp103_1)))))))))
(case-lambda
((ctx_0 added-s_0)
(begin
(with-continuation-mark*
push-authentic
current-expand-context
#f
(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
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'lift-require
added-s_0
use-s_0
result-s_0)
(void)))
result-s_0))))
(args (raise-binding-result-arity-error 2 args)))))))))
(define 1/syntax-local-lift-provide
(|#%name|
syntax-local-lift-provide
(lambda (s_0)
(begin
(call-with-values
(lambda ()
(let ((temp115_0 "not expanding in a module run-time body"))
(let ((expand-context-to-module-lifts116_0
expand-context-to-module-lifts))
(let ((add-lifted-to-module-provide!118_0
add-lifted-to-module-provide!))
(let ((temp119_0
(lambda (s_1 phase_0 to-module-lift-ctx_0)
(wrap-form 'for-syntax s_1 #f))))
(let ((temp120_0
(lambda (s_1 phase_0 to-module-lift-ctx_0)
(wrap-form '|#%provide| s_1 phase_0))))
(do-local-lift-to-module.1
add-lifted-to-module-provide!118_0
expand-context-to-module-lifts116_0
to-module-lift-context-wrt-phase
#t
#f
void
temp115_0
temp120_0
unsafe-undefined
temp119_0
'syntax-local-lift-provide
s_0)))))))
(case-lambda
((ctx_0 result-s_0)
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'lift-provide result-s_0)
(void))))
(args (raise-binding-result-arity-error 2 args))))))))
(define 1/syntax-local-lift-module-end-declaration
(|#%name|
syntax-local-lift-module-end-declaration
(lambda (s_0)
(begin
(call-with-values
(lambda ()
(let ((temp125_0
"not currently transforming an expression within a module declaration"))
(let ((expand-context-to-module-lifts126_0
expand-context-to-module-lifts))
(let ((temp127_0 (lambda (lift-ctx_0) 0)))
(let ((add-lifted-to-module-end!128_0
add-lifted-to-module-end!))
(let ((temp129_0
(lambda (orig-s_0 phase_0 to-module-lift-ctx_0)
(if (to-module-lift-context-end-as-expressions?
to-module-lift-ctx_0)
(wrap-form '|#%expression| orig-s_0 phase_0)
orig-s_0))))
(let ((temp130_0
(lambda (s_1 phase_0 to-module-lift-ctx_0)
(wrap-form 'begin-for-syntax s_1 phase_0))))
(do-local-lift-to-module.1
add-lifted-to-module-end!128_0
expand-context-to-module-lifts126_0
temp127_0
#t
'lift-end-decl
void
temp125_0
unsafe-undefined
temp129_0
temp130_0
'syntax-local-lift-module-end-declaration
s_0))))))))
(case-lambda
((ctx_0 also-s_0) (void))
(args (raise-binding-result-arity-error 2 args))))))))
(define wrap-form
(lambda (sym_0 s_0 phase_0)
(datum->syntax$1
#f
(list
(datum->syntax$1
(if phase_0 (syntax-shift-phase-level$1 core-stx phase_0) #f)
sym_0)
s_0))))
(define 1/syntax-local-module-defined-identifiers
(|#%name|
syntax-local-module-defined-identifiers
(lambda ()
(begin
(begin
(if (1/syntax-local-transforming-module-provides?)
(void)
(raise-arguments-error
'syntax-local-module-defined-identifiers
"not currently transforming module provides"))
(let ((ctx_0
(get-current-expand-context.1
#f
'syntax-local-module-defined-identifiers)))
(requireds->phase-ht
(extract-module-definitions
(begin-unsafe
(expand-context/inner-requires+provides
(root-expand-context/outer-inner ctx_0)))))))))))
(define 1/syntax-local-module-required-identifiers
(|#%name|
syntax-local-module-required-identifiers
(lambda (mod-path_0 phase-level_0)
(begin
(begin
(if (let ((or-part_0 (not mod-path_0)))
(if or-part_0 or-part_0 (1/module-path? mod-path_0)))
(void)
(raise-argument-error
'syntax-local-module-required-identifiers
"(or/c module-path? #f)"
mod-path_0))
(begin
(if (let ((or-part_0 (eq? phase-level_0 #t)))
(if or-part_0 or-part_0 (phase? phase-level_0)))
(void)
(raise-argument-error
'syntax-local-module-required-identifiers
(format "(or/c ~a #t)" phase?-string)
phase-level_0))
(begin
(if (1/syntax-local-transforming-module-provides?)
(void)
(raise-arguments-error
'syntax-local-module-required-identifiers
"not currently transforming module provides"))
(let ((ctx_0
(get-current-expand-context.1
#f
'syntax-local-module-required-identifiers)))
(let ((requires+provides_0
(begin-unsafe
(expand-context/inner-requires+provides
(root-expand-context/outer-inner ctx_0)))))
(let ((mpi_0
(if mod-path_0
(module-path->mpi/context mod-path_0 ctx_0)
#f)))
(let ((requireds_0
(extract-all-module-requires
requires+provides_0
mpi_0
(if (eq? phase-level_0 #t) 'all phase-level_0))))
(if requireds_0
(reverse$1
(let ((ht_0 (requireds->phase-ht requireds_0)))
(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 ht_0 i_0))
(case-lambda
((phase_0 ids_0)
(let ((fold-var_1
(cons
(cons phase_0 ids_0)
fold-var_0)))
(let ((fold-var_2
(values fold-var_1)))
(for-loop_0
fold-var_2
(hash-iterate-next ht_0 i_0)))))
(args
(raise-binding-result-arity-error
2
args))))
fold-var_0))))))
(for-loop_0 null (hash-iterate-first ht_0))))))
#f))))))))))))
(define requireds->phase-ht
(lambda (requireds_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_0 lst_0)
(begin
(if (pair? lst_0)
(let ((r_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_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))))
(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
(|#%name|
syntax-local-module-exports
(lambda (mod-path_0)
(begin
(begin
(if (let ((or-part_0 (1/module-path? mod-path_0)))
(if or-part_0
or-part_0
(if (syntax?$1 mod-path_0)
(1/module-path? (syntax->datum$1 mod-path_0))
#f)))
(void)
(raise-argument-error
'syntax-local-module-exports
(string-append
"(or/c module-path?\n"
" (and/c syntax?\n"
" (lambda (stx)\n"
" (module-path? (syntax->datum stx)))))")
mod-path_0))
(let ((ctx_0
(get-current-expand-context.1
#f
'syntax-local-module-exports)))
(let ((ns_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))))
(let ((mod-name_0
(1/module-path-index-resolve
(module-path->mpi/context
(if (syntax?$1 mod-path_0)
(syntax->datum$1 mod-path_0)
mod-path_0)
ctx_0)
#t)))
(let ((m_0 (namespace->module ns_0 mod-name_0)))
(begin
(if m_0
(void)
(begin-unsafe
(raise-arguments-error
'syntax-local-module-exports
"unknown module"
"module name"
(module-name->error-string mod-name_0))))
(reverse$1
(let ((ht_0 (module-provides m_0)))
(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 ht_0 i_0))
(case-lambda
((phase_0 syms_0)
(let ((fold-var_1
(let ((fold-var_1
(cons
(cons
phase_0
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
i_1)
(begin
(if i_1
(let ((sym_0
(hash-iterate-key
syms_0
i_1)))
(let ((fold-var_2
(cons
sym_0
fold-var_1)))
(let ((fold-var_3
(values
fold-var_2)))
(for-loop_1
fold-var_3
(hash-iterate-next
syms_0
i_1)))))
fold-var_1))))))
(for-loop_1
null
(hash-iterate-first
syms_0))))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
(hash-iterate-next ht_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
fold-var_0))))))
(for-loop_0
null
(hash-iterate-first ht_0))))))))))))))))
(define 1/syntax-local-submodules
(|#%name|
syntax-local-submodules
(lambda ()
(begin
(let ((ctx_0
(get-current-expand-context.1 #f 'syntax-local-submodules)))
(let ((submods_0
(begin-unsafe
(expand-context/inner-declared-submodule-names
(root-expand-context/outer-inner ctx_0)))))
(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 submods_0 i_0))
(case-lambda
((name_0 kind_0)
(let ((fold-var_1
(if (eq? kind_0 'module)
(let ((fold-var_1
(cons name_0 fold-var_0)))
(values fold-var_1))
fold-var_0)))
(for-loop_0
fold-var_1
(hash-iterate-next submods_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
fold-var_0))))))
(for-loop_0 null (hash-iterate-first submods_0)))))))))))
(define syntax-local-expand-observer
(lambda ()
(let ((ctx_0
(get-current-expand-context.1 #f 'syntax-local-expand-observer)))
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0))))))
(define 1/syntax-local-get-shadower
(let ((syntax-local-get-shadower_0
(|#%name|
syntax-local-get-shadower
(lambda (id42_0 only-generated?41_0)
(begin
(begin
(if (identifier? id42_0)
(void)
(raise-argument-error
'syntax-local-get-shadower
"identifier?"
id42_0))
(let ((ctx_0
(get-current-expand-context.1
#f
'syntax-local-get-shadower)))
(let ((new-id_0
(add-scopes
id42_0
(begin-unsafe (expand-context/outer-scopes ctx_0)))))
(if (begin-unsafe
(let ((v_0 (syntax-tamper id42_0)))
(begin-unsafe (not v_0))))
new-id_0
(syntax-taint$1 new-id_0))))))))))
(|#%name|
syntax-local-get-shadower
(case-lambda
((id_0) (begin (syntax-local-get-shadower_0 id_0 #f)))
((id_0 only-generated?41_0)
(syntax-local-get-shadower_0 id_0 only-generated?41_0))))))
(define 1/syntax-source
(|#%name|
syntax-source
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-source "syntax?" s_0))
(let ((srcloc_0 (syntax-srcloc s_0)))
(if srcloc_0 (srcloc-source srcloc_0) #f)))))))
(define 1/syntax-line
(|#%name|
syntax-line
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-line "syntax?" s_0))
(let ((srcloc_0 (syntax-srcloc s_0)))
(if srcloc_0 (srcloc-line srcloc_0) #f)))))))
(define 1/syntax-column
(|#%name|
syntax-column
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-column "syntax?" s_0))
(let ((srcloc_0 (syntax-srcloc s_0)))
(if srcloc_0 (srcloc-column srcloc_0) #f)))))))
(define 1/syntax-position
(|#%name|
syntax-position
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-position "syntax?" s_0))
(let ((srcloc_0 (syntax-srcloc s_0)))
(if srcloc_0 (srcloc-position srcloc_0) #f)))))))
(define 1/syntax-span
(|#%name|
syntax-span
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-span "syntax?" s_0))
(let ((srcloc_0 (syntax-srcloc s_0)))
(if srcloc_0 (srcloc-span srcloc_0) #f)))))))
(define encoded-srcloc?
(lambda (v_0)
(let ((or-part_0
(if (list? v_0)
(if (= (length v_0) 5) (srcloc-vector? (list->vector v_0)) #f)
#f)))
(if or-part_0
or-part_0
(if (vector? v_0)
(if (= (vector-length v_0) 5) (srcloc-vector? v_0) #f)
#f)))))
(define srcloc-vector?
(lambda (v_0)
(if (let ((or-part_0 (not (vector-ref v_0 1))))
(if or-part_0
or-part_0
(exact-positive-integer? (vector-ref v_0 1))))
(if (let ((or-part_0 (not (vector-ref v_0 2))))
(if or-part_0
or-part_0
(exact-nonnegative-integer? (vector-ref v_0 2))))
(if (let ((or-part_0 (not (vector-ref v_0 3))))
(if or-part_0
or-part_0
(exact-positive-integer? (vector-ref v_0 3))))
(let ((or-part_0 (not (vector-ref v_0 4))))
(if or-part_0
or-part_0
(exact-nonnegative-integer? (vector-ref v_0 4))))
#f)
#f)
#f)))
(define to-srcloc-stx
(lambda (v_0)
(if (srcloc? v_0)
(if (syntax?$1 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))
(if (vector? v_0)
(if (syntax?$1 empty-syntax)
(let ((srcloc2_0
(let ((app_0 (vector-ref v_0 0)))
(let ((app_1 (vector-ref v_0 1)))
(let ((app_2 (vector-ref v_0 2)))
(let ((app_3 (vector-ref v_0 3)))
(unsafe-make-srcloc
app_0
app_1
app_2
app_3
(vector-ref v_0 4))))))))
(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
(|#%name|
syntax-e
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-e "syntax?" s_0))
(syntax-e$1 s_0))))))
(define 1/syntax->datum
(|#%name|
syntax->datum
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax->datum "syntax?" s_0))
(syntax->datum$1 s_0))))))
(define maybe-syntax->datum
(lambda (s_0) (if (syntax?$1 s_0) (syntax->datum$1 s_0) s_0)))
(define 1/datum->syntax
(let ((datum->syntax_0
(|#%name|
datum->syntax
(lambda (stx-c4_0 s5_0 stx-l1_0 stx-p2_0 ignored3_0)
(begin
(begin
(if (let ((or-part_0 (not stx-c4_0)))
(if or-part_0 or-part_0 (syntax?$1 stx-c4_0)))
(void)
(raise-argument-error
'datum->syntax
"(or #f syntax?)"
stx-c4_0))
(if (let ((or-part_0 (not stx-l1_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (syntax?$1 stx-l1_0)))
(if or-part_1
or-part_1
(encoded-srcloc? stx-l1_0)))))
(void)
(raise-argument-error
'datum->syntax
(string-append
"(or #f syntax?\n"
" (list/c any/c\n"
" (or/c exact-positive-integer? #f)\n"
" (or/c exact-nonnegative-integer? #f)\n"
" (or/c exact-positive-integer? #f)\n"
" (or/c exact-nonnegative-integer? #f))\n"
" (vector/c any/c\n"
" (or/c exact-positive-integer? #f)\n"
" (or/c exact-nonnegative-integer? #f)\n"
" (or/c exact-positive-integer? #f)\n"
" (or/c exact-nonnegative-integer? #f)))")
stx-l1_0))
(if (let ((or-part_0 (not stx-p2_0)))
(if or-part_0 or-part_0 (syntax?$1 stx-p2_0)))
(void)
(raise-argument-error
'datum->syntax
"(or #f syntax?)"
stx-p2_0))
(datum->syntax$1
stx-c4_0
s5_0
(to-srcloc-stx stx-l1_0)
stx-p2_0)))))))
(|#%name|
datum->syntax
(case-lambda
((stx-c_0 s_0) (begin (datum->syntax_0 stx-c_0 s_0 #f #f #f)))
((stx-c_0 s_0 stx-l_0 stx-p_0 ignored3_0)
(datum->syntax_0 stx-c_0 s_0 stx-l_0 stx-p_0 ignored3_0))
((stx-c_0 s_0 stx-l_0 stx-p2_0)
(datum->syntax_0 stx-c_0 s_0 stx-l_0 stx-p2_0 #f))
((stx-c_0 s_0 stx-l1_0) (datum->syntax_0 stx-c_0 s_0 stx-l1_0 #f #f))))))
(define 1/syntax-binding-set
(|#%name|
syntax-binding-set
(lambda () (begin (syntax-binding-set1.1 null)))))
(define 1/syntax-binding-set-extend
(let ((syntax-binding-set-extend_0
(|#%name|
syntax-binding-set-extend
(lambda (bs13_0
as-sym14_0
as-phase15_0
mpi16_0
sym6_0
phase7_0
nominal-mpi8_0
nominal-phase9_0
nominal-sym10_0
nominal-require-phase11_0
insp12_0)
(begin
(let ((sym_0
(if (eq? sym6_0 unsafe-undefined) as-sym14_0 sym6_0)))
(let ((phase_0
(if (eq? phase7_0 unsafe-undefined)
as-phase15_0
phase7_0)))
(let ((nominal-mpi_0
(if (eq? nominal-mpi8_0 unsafe-undefined)
mpi16_0
nominal-mpi8_0)))
(let ((nominal-phase_0
(if (eq? nominal-phase9_0 unsafe-undefined)
phase_0
nominal-phase9_0)))
(let ((nominal-sym_0
(if (eq? nominal-sym10_0 unsafe-undefined)
sym_0
nominal-sym10_0)))
(begin
(if (1/syntax-binding-set? bs13_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
"syntax-binding-set?"
bs13_0))
(if (symbol? as-sym14_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
"symbol?"
as-sym14_0))
(if (phase? as-phase15_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
phase?-string
as-phase15_0))
(if (1/module-path-index? mpi16_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
"module-path-index?"
mpi16_0))
(if (symbol? sym_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
"symbol?"
sym_0))
(if (phase? phase_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
phase?-string
phase_0))
(if (1/module-path-index? nominal-mpi_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
"module-path-index?"
nominal-mpi_0))
(if (phase? nominal-phase_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
phase?-string
nominal-phase_0))
(if (symbol? nominal-sym_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
"symbol?"
nominal-sym_0))
(if (phase? nominal-require-phase11_0)
(void)
(raise-argument-error
'syntax-binding-set-extend
phase?-string
nominal-require-phase11_0))
(if (let ((or-part_0 (not insp12_0)))
(if or-part_0 or-part_0 (inspector? insp12_0)))
(void)
(raise-argument-error
'syntax-binding-set-extend
"(or/c inspector? #f)"
insp12_0))
(syntax-binding-set-extend$1
bs13_0
as-sym14_0
as-phase15_0
mpi16_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym_0
nominal-require-phase11_0
insp12_0))))))))))))
(|#%name|
syntax-binding-set-extend
(case-lambda
((bs_0 as-sym_0 as-phase_0 mpi_0)
(begin
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
0
#f)))
((bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym_0
nominal-require-phase_0
insp12_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym_0
nominal-require-phase_0
insp12_0))
((bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym_0
nominal-require-phase11_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym_0
nominal-require-phase11_0
#f))
((bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym10_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase_0
nominal-sym10_0
0
#f))
((bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase9_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi_0
nominal-phase9_0
unsafe-undefined
0
#f))
((bs_0 as-sym_0 as-phase_0 mpi_0 sym_0 phase_0 nominal-mpi8_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase_0
nominal-mpi8_0
unsafe-undefined
unsafe-undefined
0
#f))
((bs_0 as-sym_0 as-phase_0 mpi_0 sym_0 phase7_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym_0
phase7_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
0
#f))
((bs_0 as-sym_0 as-phase_0 mpi_0 sym6_0)
(syntax-binding-set-extend_0
bs_0
as-sym_0
as-phase_0
mpi_0
sym6_0
unsafe-undefined
unsafe-undefined
unsafe-undefined
unsafe-undefined
0
#f))))))
(define 1/syntax-binding-set->syntax
(|#%name|
syntax-binding-set->syntax
(lambda (bs_0 datum_0)
(begin
(begin
(if (1/syntax-binding-set? bs_0)
(void)
(raise-argument-error
'syntax-binding-set->syntax
"syntax-binding-set?"
bs_0))
(syntax-binding-set->syntax$1 bs_0 datum_0))))))
(define 1/syntax->list
(|#%name|
syntax->list
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax->list "syntax?" s_0))
(syntax->list$1 s_0))))))
(define 1/syntax-original?
(|#%name|
syntax-original?
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-original? "syntax?" s_0))
(if (syntax-property$1 s_0 original-property-sym)
(not (syntax-any-macro-scopes? s_0))
#f))))))
(define 1/bound-identifier=?
(let ((bound-identifier=?_0
(|#%name|
bound-identifier=?
(lambda (a18_0 b19_0 phase17_0)
(begin
(let ((phase_0
(if (eq? phase17_0 unsafe-undefined)
(1/syntax-local-phase-level)
phase17_0)))
(begin
(if (identifier? a18_0)
(void)
(raise-argument-error
'bound-identifier=?
"identifier?"
a18_0))
(if (identifier? b19_0)
(void)
(raise-argument-error
'bound-identifier=?
"identifier?"
b19_0))
(if (phase? phase_0)
(void)
(raise-argument-error
'bound-identifier=?
phase?-string
phase_0))
(bound-identifier=?$1 a18_0 b19_0 phase_0))))))))
(|#%name|
bound-identifier=?
(case-lambda
((a_0 b_0) (begin (bound-identifier=?_0 a_0 b_0 unsafe-undefined)))
((a_0 b_0 phase17_0) (bound-identifier=?_0 a_0 b_0 phase17_0))))))
(define 1/free-identifier=?
(let ((free-identifier=?_0
(|#%name|
free-identifier=?
(lambda (a22_0 b23_0 a-phase20_0 b-phase21_0)
(begin
(let ((a-phase_0
(if (eq? a-phase20_0 unsafe-undefined)
(1/syntax-local-phase-level)
a-phase20_0)))
(let ((b-phase_0
(if (eq? b-phase21_0 unsafe-undefined)
a-phase_0
b-phase21_0)))
(begin
(if (identifier? a22_0)
(void)
(raise-argument-error
'free-identifier=?
"identifier?"
a22_0))
(if (identifier? b23_0)
(void)
(raise-argument-error
'free-identifier=?
"identifier?"
b23_0))
(if (phase? a-phase_0)
(void)
(raise-argument-error
'free-identifier=?
phase?-string
a-phase_0))
(if (phase? b-phase_0)
(void)
(raise-argument-error
'free-identifier=?
phase?-string
b-phase_0))
(free-identifier=?$1
a22_0
b23_0
a-phase_0
b-phase_0)))))))))
(|#%name|
free-identifier=?
(case-lambda
((a_0 b_0)
(begin (free-identifier=?_0 a_0 b_0 unsafe-undefined unsafe-undefined)))
((a_0 b_0 a-phase_0 b-phase21_0)
(free-identifier=?_0 a_0 b_0 a-phase_0 b-phase21_0))
((a_0 b_0 a-phase20_0)
(free-identifier=?_0 a_0 b_0 a-phase20_0 unsafe-undefined))))))
(define 1/free-transformer-identifier=?
(|#%name|
free-transformer-identifier=?
(lambda (a_0 b_0)
(begin
(begin
(if (identifier? a_0)
(void)
(raise-argument-error
'free-transformer-identifier=?
"identifier?"
a_0))
(begin
(if (identifier? b_0)
(void)
(raise-argument-error
'free-transformer-identifier=?
"identifier?"
b_0))
(let ((phase_0 (add1 (1/syntax-local-phase-level))))
(free-identifier=?$1 a_0 b_0 phase_0 phase_0))))))))
(define 1/free-template-identifier=?
(|#%name|
free-template-identifier=?
(lambda (a_0 b_0)
(begin
(begin
(if (identifier? a_0)
(void)
(raise-argument-error
'free-template-identifier=?
"identifier?"
a_0))
(begin
(if (identifier? b_0)
(void)
(raise-argument-error
'free-template-identifier=?
"identifier?"
b_0))
(let ((phase_0 (sub1 (1/syntax-local-phase-level))))
(free-identifier=?$1 a_0 b_0 phase_0 phase_0))))))))
(define 1/free-label-identifier=?
(|#%name|
free-label-identifier=?
(lambda (a_0 b_0)
(begin
(begin
(if (identifier? a_0)
(void)
(raise-argument-error 'free-label-identifier=? "identifier?" a_0))
(if (identifier? b_0)
(void)
(raise-argument-error 'free-label-identifier=? "identifier?" b_0))
(free-identifier=?$1 a_0 b_0 #f #f))))))
(define 1/identifier-binding
(let ((identifier-binding_0
(|#%name|
identifier-binding
(lambda (id26_0 phase24_0 top-level-symbol?25_0)
(begin
(let ((phase_0
(if (eq? phase24_0 unsafe-undefined)
(1/syntax-local-phase-level)
phase24_0)))
(begin
(if (identifier? id26_0)
(void)
(raise-argument-error
'identifier-binding
"identifier?"
id26_0))
(if (phase? phase_0)
(void)
(raise-argument-error
'identifier-binding
phase?-string
phase_0))
(identifier-binding$1
id26_0
phase_0
top-level-symbol?25_0))))))))
(|#%name|
identifier-binding
(case-lambda
((id_0) (begin (identifier-binding_0 id_0 unsafe-undefined #f)))
((id_0 phase_0 top-level-symbol?25_0)
(identifier-binding_0 id_0 phase_0 top-level-symbol?25_0))
((id_0 phase24_0) (identifier-binding_0 id_0 phase24_0 #f))))))
(define 1/identifier-transformer-binding
(let ((identifier-transformer-binding_0
(|#%name|
identifier-transformer-binding
(lambda (id28_0 phase27_0)
(begin
(let ((phase_0
(if (eq? phase27_0 unsafe-undefined)
(1/syntax-local-phase-level)
phase27_0)))
(begin
(if (identifier? id28_0)
(void)
(raise-argument-error
'identifier-transformer-binding
"identifier?"
id28_0))
(identifier-binding$1
id28_0
(if phase_0 (add1 phase_0) #f)))))))))
(|#%name|
identifier-transformer-binding
(case-lambda
((id_0) (begin (identifier-transformer-binding_0 id_0 unsafe-undefined)))
((id_0 phase27_0) (identifier-transformer-binding_0 id_0 phase27_0))))))
(define 1/identifier-template-binding
(|#%name|
identifier-template-binding
(lambda (id_0)
(begin
(begin
(if (identifier? id_0)
(void)
(raise-argument-error
'identifier-template-binding
"identifier?"
id_0))
(identifier-binding$1 id_0 (sub1 (1/syntax-local-phase-level))))))))
(define 1/identifier-label-binding
(|#%name|
identifier-label-binding
(lambda (id_0)
(begin
(begin
(if (identifier? id_0)
(void)
(raise-argument-error 'identifier-label-binding "identifier?" id_0))
(identifier-binding$1 id_0 #f))))))
(define 1/identifier-binding-symbol
(let ((identifier-binding-symbol_0
(|#%name|
identifier-binding-symbol
(lambda (id30_0 phase29_0)
(begin
(let ((phase_0
(if (eq? phase29_0 unsafe-undefined)
(1/syntax-local-phase-level)
phase29_0)))
(begin
(if (identifier? id30_0)
(void)
(raise-argument-error
'identifier-binding-symbol
"identifier?"
id30_0))
(if (phase? phase_0)
(void)
(raise-argument-error
'identifier-binding-symbol
phase?-string
phase_0))
(identifier-binding-symbol$1 id30_0 phase_0))))))))
(|#%name|
identifier-binding-symbol
(case-lambda
((id_0) (begin (identifier-binding-symbol_0 id_0 unsafe-undefined)))
((id_0 phase29_0) (identifier-binding-symbol_0 id_0 phase29_0))))))
(define 1/identifier-prune-lexical-context
(let ((identifier-prune-lexical-context_0
(|#%name|
identifier-prune-lexical-context
(lambda (id32_0 syms31_0)
(begin
(begin
(if (identifier? id32_0)
(void)
(raise-argument-error
'identifier-prune-lexical-context
"identifier?"
id32_0))
(if (if (list? syms31_0) (andmap_2344 symbol? syms31_0) #f)
(void)
(raise-argument-error
'identifier-prune-lexical-context
"(listof symbol?)"
syms31_0))
id32_0))))))
(|#%name|
identifier-prune-lexical-context
(case-lambda
((id_0) (begin (identifier-prune-lexical-context_0 id_0 null)))
((id_0 syms31_0) (identifier-prune-lexical-context_0 id_0 syms31_0))))))
(define 1/syntax-debug-info
(let ((syntax-debug-info_0
(|#%name|
syntax-debug-info
(lambda (s35_0 phase33_0 all-bindings?34_0)
(begin
(let ((phase_0
(if (eq? phase33_0 unsafe-undefined)
(1/syntax-local-phase-level)
phase33_0)))
(begin
(if (syntax?$1 s35_0)
(void)
(raise-argument-error 'syntax-debug-info "syntax?" s35_0))
(if (phase? phase_0)
(void)
(raise-argument-error
'syntax-debug-info
phase?-string
phase_0))
(syntax-debug-info$1 s35_0 phase_0 all-bindings?34_0))))))))
(|#%name|
syntax-debug-info
(case-lambda
((s_0) (begin (syntax-debug-info_0 s_0 unsafe-undefined #f)))
((s_0 phase_0 all-bindings?34_0)
(syntax-debug-info_0 s_0 phase_0 all-bindings?34_0))
((s_0 phase33_0) (syntax-debug-info_0 s_0 phase33_0 #f))))))
(define 1/syntax-shift-phase-level
(|#%name|
syntax-shift-phase-level
(lambda (s_0 phase_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-shift-phase-level "syntax?" s_0))
(if (phase? phase_0)
(void)
(raise-argument-error
'syntax-shift-phase-level
phase?-string
phase_0))
(syntax-shift-phase-level$1 s_0 phase_0))))))
(define 1/syntax-track-origin
(|#%name|
syntax-track-origin
(lambda (new-stx_0 old-stx_0 id_0)
(begin
(begin
(if (syntax?$1 new-stx_0)
(void)
(raise-argument-error 'syntax-track-origin "syntax?" new-stx_0))
(begin
(if (syntax?$1 old-stx_0)
(void)
(raise-argument-error 'syntax-track-origin "syntax?" old-stx_0))
(begin
(if (identifier? id_0)
(void)
(raise-argument-error 'syntax-track-origin "identifier?" id_0))
(let ((s_0 (syntax-track-origin$1 new-stx_0 old-stx_0 id_0)))
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'track-origin
new-stx_0
s_0)
(void)))
(void))
s_0))))))))))
(define 1/namespace-attach-module
(let ((namespace-attach-module_0
(|#%name|
namespace-attach-module
(lambda (src-namespace2_0 mod-path3_0 dest-namespace1_0)
(begin
(let ((dest-namespace_0
(if (eq? dest-namespace1_0 unsafe-undefined)
(1/current-namespace)
dest-namespace1_0)))
(do-attach-module.1
#t
'namespace-attach-module
src-namespace2_0
mod-path3_0
dest-namespace_0)))))))
(|#%name|
namespace-attach-module
(case-lambda
((src-namespace_0 mod-path_0)
(begin
(namespace-attach-module_0
src-namespace_0
mod-path_0
unsafe-undefined)))
((src-namespace_0 mod-path_0 dest-namespace1_0)
(namespace-attach-module_0
src-namespace_0
mod-path_0
dest-namespace1_0))))))
(define 1/namespace-attach-module-declaration
(let ((namespace-attach-module-declaration_0
(|#%name|
namespace-attach-module-declaration
(lambda (src-namespace5_0 mod-path6_0 dest-namespace4_0)
(begin
(let ((dest-namespace_0
(if (eq? dest-namespace4_0 unsafe-undefined)
(1/current-namespace)
dest-namespace4_0)))
(do-attach-module.1
#f
'namespace-attach-module-declaration
src-namespace5_0
mod-path6_0
dest-namespace_0)))))))
(|#%name|
namespace-attach-module-declaration
(case-lambda
((src-namespace_0 mod-path_0)
(begin
(namespace-attach-module-declaration_0
src-namespace_0
mod-path_0
unsafe-undefined)))
((src-namespace_0 mod-path_0 dest-namespace4_0)
(namespace-attach-module-declaration_0
src-namespace_0
mod-path_0
dest-namespace4_0))))))
(define do-attach-module.1
(|#%name|
do-attach-module
(lambda (attach-instances?7_0
who9_0
src-namespace10_0
mod-path11_0
dest-namespace12_0)
(begin
(begin
(if (1/namespace? src-namespace10_0)
(void)
(raise-argument-error who9_0 "namespace?" src-namespace10_0))
(begin
(if (let ((or-part_0 (1/module-path? mod-path11_0)))
(if or-part_0
or-part_0
(1/resolved-module-path? mod-path11_0)))
(void)
(raise-argument-error
who9_0
"(or/c module-path? resolved-module-path?)"
mod-path11_0))
(begin
(if (1/namespace? dest-namespace12_0)
(void)
(raise-argument-error who9_0 "namespace?" dest-namespace12_0))
(let ((phase_0 (namespace-phase src-namespace10_0)))
(begin
(if (eqv? phase_0 (namespace-phase dest-namespace12_0))
(void)
(raise-arguments-error
who9_0
"source and destination namespace phases do not match"
"source phase"
phase_0
"destination phase"
(namespace-phase dest-namespace12_0)))
(let ((todo_0 (make-hasheq)))
(let ((missing_0 kw2836))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (mpi_0
phase_1
attach-instances?_0
attach-phase_0)
(begin
(let ((mod-name_0
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
src-namespace10_0)
(1/module-path-index-resolve mpi_0))))
(let ((attach-this-instance?_0
(if attach-instances?_0
(eqv? phase_1 attach-phase_0)
#f)))
(let ((m-ns_0
(hash-ref
(hash-ref
todo_0
mod-name_0
hash2589)
phase_1
missing_0)))
(if (let ((or-part_0
(eq? missing_0 m-ns_0)))
(if or-part_0
or-part_0
(if attach-this-instance?_0
(not m-ns_0)
#f)))
(let ((m_0
(namespace->module
src-namespace10_0
mod-name_0)))
(begin
(if m_0
(void)
(raise-arguments-error
who9_0
"module not declared (in the source namespace)"
"module name"
mod-name_0))
(if (if (module-cross-phase-persistent?
m_0)
(if (not
(begin-unsafe
(not phase_1)))
(not
(begin-unsafe
(eq? phase_1 0)))
#f)
#f)
(loop_0
mpi_0
0
attach-instances?_0
0)
(let ((already-m_0
(namespace->module
dest-namespace12_0
mod-name_0)))
(begin
(if (if already-m_0
(not
(eq? already-m_0 m_0))
#f)
(raise-arguments-error
who9_0
"a different declaration is already in the destination namespace"
"module name"
mod-name_0)
(void))
(call-with-values
(lambda ()
(if (if attach-this-instance?_0
attach-this-instance?_0
(module-cross-phase-persistent?
m_0))
(let ((m-ns_1
(namespace->module-namespace.1
#f
#f
void
src-namespace10_0
mod-name_0
phase_1)))
(begin
(if m-ns_1
(void)
(raise-arguments-error
who9_0
"module not instantiated (in the source namespace)"
"module name"
mod-name_0))
(let ((already-m-ns_0
(if already-m_0
(namespace->module-namespace.1
#f
#f
void
dest-namespace12_0
mod-name_0
phase_1)
#f)))
(begin
(if (if already-m-ns_0
(if (not
(eq?
m-ns_1
already-m-ns_0))
(not
(namespace-same-instance?
m-ns_1
already-m-ns_0))
#f)
#f)
(raise-arguments-error
who9_0
"a different instance is already in the destination namespace"
"module name"
mod-name_0)
(void))
(values
m-ns_1
(if already-m-ns_0
#t
#f))))))
(begin
(if (if (begin-unsafe
(not phase_1))
(not
(namespace->module-namespace.1
#f
#f
void
src-namespace10_0
mod-name_0
phase_1))
#f)
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
src-namespace10_0)
(namespace-module-instantiate!.1
#t
unsafe-undefined
hash2610
null
#f
src-namespace10_0
mpi_0
phase_1))
(void))
(values
#f
(if already-m_0
#t
#f)))))
(case-lambda
((m-ns_1 already?_0)
(begin
(let ((xform_0
(lambda (ht_0)
(hash-set
ht_0
phase_1
m-ns_1))))
(let ((default_0
hash2589))
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
todo_0
mod-name_0
xform_0
default_0))))
(if already?_0
(void)
(begin
(let ((lst_0
(module-requires
m_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair?
lst_1)
(let ((phase+reqs_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(call-with-values
(lambda ()
(let ((lst_2
(cdr
phase+reqs_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (lst_3)
(begin
(if (pair?
lst_3)
(let ((req_0
(unsafe-car
lst_3)))
(let ((rest_1
(unsafe-cdr
lst_3)))
(begin
(let ((app_0
(module-path-index-shift
req_0
(module-self
m_0)
mpi_0)))
(loop_0
app_0
(phase+
phase_1
(car
phase+reqs_0))
attach-instances?_0
attach-phase_0))
(for-loop_1
rest_1))))
(values)))))))
(for-loop_1
lst_2)))))
(case-lambda
(()
(for-loop_0
rest_0))
(args
(raise-binding-result-arity-error
0
args))))))
(values)))))))
(for-loop_0
lst_0))))
(void)
(let ((lst_0
(module-submodule-names
m_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair?
lst_1)
(let ((submod-name_0
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(loop_0
(1/module-path-index-join
(list
'submod
"."
submod-name_0)
mpi_0)
#f
#f
attach-phase_0)
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0
lst_0))))
(void)
(if (module-supermodule-name
m_0)
(loop_0
(1/module-path-index-join
'(submod "..")
mpi_0)
#f
#f
attach-phase_0)
(void))))))
(args
(raise-binding-result-arity-error
2
args)))))))))
(void))))))))))
(loop_0
(1/module-path-index-join
(if (1/resolved-module-path? mod-path11_0)
(resolved-module-path->module-path mod-path11_0)
mod-path11_0)
#f)
phase_0
attach-instances?7_0
phase_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 todo_0 i_0))
(case-lambda
((mod-name_0 phases_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (i_1)
(begin
(if i_1
(call-with-values
(lambda ()
(hash-iterate-key+value
phases_0
i_1))
(case-lambda
((phase_1 m-ns_0)
(begin
(let ((m_0
(namespace->module
src-namespace10_0
mod-name_0)))
(begin
(begin-unsafe
(|#%app|
(module-force-bulk-binding
m_0)
(namespace-bulk-binding-registry
src-namespace10_0)))
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
dest-namespace12_0)
(declare-module!.1
#t
dest-namespace12_0
m_0
mod-name_0))
(if m-ns_0
(begin
(namespace-record-module-instance-attached!
src-namespace10_0
mod-name_0
phase_1)
(let ((or-part_0
(namespace->module-namespace.1
#f
#f
void
dest-namespace12_0
mod-name_0
phase_1)))
(if or-part_0
or-part_0
(namespace-install-module-namespace!
dest-namespace12_0
mod-name_0
phase_1
m_0
m-ns_0))))
(void))))
(for-loop_1
(hash-iterate-next
phases_0
i_1))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_1
(hash-iterate-first
phases_0)))))
(case-lambda
(()
(for-loop_0
(hash-iterate-next todo_0 i_0)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_0 (hash-iterate-first todo_0))))
(let ((mnr_0
(|#%app| 1/current-module-name-resolver)))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
dest-namespace12_0)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((mod-name_0
(hash-iterate-key
todo_0
i_0)))
(begin
(|#%app|
mnr_0
mod-name_0
src-namespace10_0)
(for-loop_0
(hash-iterate-next
todo_0
i_0))))
(values)))))))
(for-loop_0 (hash-iterate-first todo_0))))
(void)))))))))))))))))
(define 1/make-empty-namespace
(|#%name|
make-empty-namespace
(lambda ()
(begin
(let ((current-ns_0 (1/current-namespace)))
(let ((phase_0 (namespace-phase current-ns_0)))
(let ((ns_0
(namespace->namespace-at-phase (make-namespace) phase_0)))
(begin
(1/namespace-attach-module current-ns_0 ''|#%kernel| ns_0)
(namespace-primitive-module-visit! ns_0 '|#%kernel|)
ns_0))))))))
(define 1/namespace-syntax-introduce
(let ((namespace-syntax-introduce_0
(|#%name|
namespace-syntax-introduce
(lambda (s2_0 ns1_0)
(begin
(let ((ns_0
(if (eq? ns1_0 unsafe-undefined)
(1/current-namespace)
ns1_0)))
(begin
(if (syntax?$1 s2_0)
(void)
(raise-argument-error
'namespace-syntax-introduce
"syntax?"
s2_0))
(begin
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-syntax-introduce
"namespace?"
ns_0))
(let ((root-ctx_0 (namespace-get-root-expand-ctx ns_0)))
(let ((post-scope_0
(post-expansion-scope
(begin-unsafe
(root-expand-context/outer-post-expansion
root-ctx_0)))))
(let ((other-namespace-scopes_0
(reverse$1
(let ((ht_0
(syntax-scope-set
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner
root-ctx_0)))
0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 i_0)
(begin
(if i_0
(let ((sc_0
(unsafe-immutable-hash-iterate-key
ht_0
i_0)))
(let ((fold-var_1
(if (equal?
sc_0
post-scope_0)
fold-var_0
(let ((fold-var_1
(cons
sc_0
fold-var_0)))
(values
fold-var_1)))))
(for-loop_0
fold-var_1
(unsafe-immutable-hash-iterate-next
ht_0
i_0))))
fold-var_0))))))
(for-loop_0
null
(unsafe-immutable-hash-iterate-first
ht_0))))))))
(let ((add-ns-scopes_0
(|#%name|
add-ns-scopes
(lambda (s_0)
(begin
(let ((temp40_0
(add-scopes
(push-scope s_0 post-scope_0)
other-namespace-scopes_0)))
(let ((temp41_0
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((temp42_0
(let ((or-part_0
(namespace-declaration-inspector
ns_0)))
(if or-part_0
or-part_0
(current-code-inspector)))))
(let ((temp41_1 temp41_0)
(temp40_1 temp40_0))
(syntax-transfer-shifts.1
#t
temp40_1
temp41_1
temp42_0))))))))))
(let ((maybe-module-id_0
(if (pair? (1/syntax-e s2_0))
(if (identifier? (car (1/syntax-e s2_0)))
(add-ns-scopes_0
(car (1/syntax-e s2_0)))
#f)
#f)))
(if (if maybe-module-id_0
(1/free-identifier=?
maybe-module-id_0
(1/namespace-module-identifier ns_0)
(namespace-phase ns_0))
#f)
(1/datum->syntax
s2_0
(cons
maybe-module-id_0
(cdr (1/syntax-e s2_0)))
s2_0
s2_0)
(add-ns-scopes_0 s2_0)))))))))))))))
(|#%name|
namespace-syntax-introduce
(case-lambda
((s_0) (begin (namespace-syntax-introduce_0 s_0 unsafe-undefined)))
((s_0 ns1_0) (namespace-syntax-introduce_0 s_0 ns1_0))))))
(define namespace-datum-introduce
(lambda (s_0) (1/namespace-syntax-introduce (1/datum->syntax #f s_0))))
(define 1/namespace-module-identifier
(let ((namespace-module-identifier_0
(|#%name|
namespace-module-identifier
(lambda (where3_0)
(begin
(let ((where_0
(if (eq? where3_0 unsafe-undefined)
(1/current-namespace)
where3_0)))
(begin
(if (let ((or-part_0 (1/namespace? where_0)))
(if or-part_0 or-part_0 (phase? where_0)))
(void)
(raise-argument-error
'namespace-module-identifier
(string-append "(or/c namespace? " phase?-string ")")
where_0))
(1/datum->syntax
(1/syntax-shift-phase-level
core-stx
(if (1/namespace? where_0)
(namespace-phase where_0)
where_0))
'module))))))))
(|#%name|
namespace-module-identifier
(case-lambda
(() (begin (namespace-module-identifier_0 unsafe-undefined)))
((where3_0) (namespace-module-identifier_0 where3_0))))))
(define 1/namespace-symbol->identifier
(|#%name|
namespace-symbol->identifier
(lambda (sym_0)
(begin
(begin
(if (symbol? sym_0)
(void)
(raise-argument-error
'namespace-symbol->identifier
"symbol?"
sym_0))
(1/namespace-syntax-introduce (1/datum->syntax #f sym_0)))))))
(define do-namespace-require.1
(|#%name|
do-namespace-require
(lambda (copy-variable-as-constant?7_0
copy-variable-phase-level6_0
run?4_0
skip-variable-phase-level8_0
visit?5_0
who14_0
req15_0
ns16_0)
(begin
(begin
(if (1/namespace? ns16_0)
(void)
(raise-argument-error who14_0 "namespace?" ns16_0))
(let ((ctx-stx_0
(add-scopes
empty-syntax
(let ((v_0 (namespace-get-root-expand-ctx ns16_0)))
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner v_0)))))))
(if (let ((or-part_0 (1/module-path-index? req15_0)))
(if or-part_0 or-part_0 (1/module-path? req15_0)))
(let ((temp46_0
(if (1/module-path-index? req15_0)
req15_0
(1/module-path-index-join req15_0 #f))))
(let ((temp53_0 (namespace-phase ns16_0)))
(let ((temp54_0 (namespace-phase ns16_0)))
(let ((temp53_1 temp53_0) (temp46_1 temp46_0))
(perform-require!.1
#f
#t
#f
copy-variable-as-constant?7_0
copy-variable-phase-level6_0
#f
'all
temp53_1
#f
temp54_0
run?4_0
skip-variable-phase-level8_0
visit?5_0
who14_0
temp46_1
#f
#f
ctx-stx_0
ns16_0)))))
(let ((temp61_0 (list (1/datum->syntax ctx-stx_0 req15_0))))
(let ((temp64_0 (namespace-phase ns16_0)))
(let ((temp65_0 (make-requires+provides.1 #f #f)))
(let ((temp64_1 temp64_0) (temp61_1 temp61_0))
(parse-and-perform-requires!.1
copy-variable-as-constant?7_0
copy-variable-phase-level6_0
hash2610
#f
unsafe-undefined
run?4_0
#f
skip-variable-phase-level8_0
visit?5_0
who14_0
temp61_1
#f
ns16_0
temp64_1
temp65_0))))))))))))
(define 1/namespace-require
(let ((namespace-require_0
(|#%name|
namespace-require
(lambda (req19_0 ns18_0)
(begin
(let ((ns_0
(if (eq? ns18_0 unsafe-undefined)
(1/current-namespace)
ns18_0)))
(do-namespace-require.1
#f
#f
#t
#f
#f
'namespace-require
req19_0
ns_0)))))))
(|#%name|
namespace-require
(case-lambda
((req_0) (begin (namespace-require_0 req_0 unsafe-undefined)))
((req_0 ns18_0) (namespace-require_0 req_0 ns18_0))))))
(define 1/namespace-require/expansion-time
(let ((namespace-require/expansion-time_0
(|#%name|
namespace-require/expansion-time
(lambda (req21_0 ns20_0)
(begin
(let ((ns_0
(if (eq? ns20_0 unsafe-undefined)
(1/current-namespace)
ns20_0)))
(do-namespace-require.1
#f
#f
#f
#f
#t
'namespace-require/expansion-time
req21_0
ns_0)))))))
(|#%name|
namespace-require/expansion-time
(case-lambda
((req_0)
(begin (namespace-require/expansion-time_0 req_0 unsafe-undefined)))
((req_0 ns20_0) (namespace-require/expansion-time_0 req_0 ns20_0))))))
(define 1/namespace-require/constant
(let ((namespace-require/constant_0
(|#%name|
namespace-require/constant
(lambda (req23_0 ns22_0)
(begin
(let ((ns_0
(if (eq? ns22_0 unsafe-undefined)
(1/current-namespace)
ns22_0)))
(do-namespace-require.1
#t
0
#t
#f
#f
'namespace-require/constant
req23_0
ns_0)))))))
(|#%name|
namespace-require/constant
(case-lambda
((req_0) (begin (namespace-require/constant_0 req_0 unsafe-undefined)))
((req_0 ns22_0) (namespace-require/constant_0 req_0 ns22_0))))))
(define 1/namespace-require/copy
(let ((namespace-require/copy_0
(|#%name|
namespace-require/copy
(lambda (req25_0 ns24_0)
(begin
(let ((ns_0
(if (eq? ns24_0 unsafe-undefined)
(1/current-namespace)
ns24_0)))
(do-namespace-require.1
#f
0
#t
0
#f
'namespace-require/copy
req25_0
ns_0)))))))
(|#%name|
namespace-require/copy
(case-lambda
((req_0) (begin (namespace-require/copy_0 req_0 unsafe-undefined)))
((req_0 ns24_0) (namespace-require/copy_0 req_0 ns24_0))))))
(define 1/namespace-variable-value
(let ((namespace-variable-value_0
(|#%name|
namespace-variable-value
(lambda (sym29_0 use-mapping?26_0 failure-thunk27_0 ns28_0)
(begin
(let ((ns_0
(if (eq? ns28_0 unsafe-undefined)
(1/current-namespace)
ns28_0)))
(begin
(if (symbol? sym29_0)
(void)
(raise-argument-error
'namespace-variable-value
"symbol?"
sym29_0))
(if (let ((or-part_0 (not failure-thunk27_0)))
(if or-part_0
or-part_0
(if (procedure? failure-thunk27_0)
(procedure-arity-includes? failure-thunk27_0 0)
#f)))
(void)
(raise-argument-error
'namespace-variable-value
"(or/c #f (procedure-arity-includes/c 0))"
failure-thunk27_0))
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-variable-value
"namespace?"
ns_0))
(|#%app|
(call-with-escape-continuation
(lambda (escape_0)
(call-with-values
(lambda ()
(if use-mapping?26_0
(let ((id_0 (1/datum->syntax #f sym29_0)))
(let ((b_0
(resolve+shift/extra-inspector
(1/namespace-syntax-introduce id_0 ns_0)
(namespace-phase ns_0)
ns_0)))
(begin
(if b_0
(namespace-visit-available-modules! ns_0)
(void))
(call-with-values
(lambda ()
(if b_0
(let ((temp98_0 (namespace-phase ns_0)))
(binding-lookup.1
#f
#f
b_0
empty-env
null
ns_0
temp98_0
id_0))
(values variable #f #f #f)))
(case-lambda
((v_0
primitive?_0
extra-inspector_0
protected?_0)
(begin
(if (variable? v_0)
(void)
(|#%app|
escape_0
(if failure-thunk27_0
failure-thunk27_0
(lambda ()
(raise
(let ((app_0
(format
(string-append
"namespace-variable-value: bound to syntax\n"
" in: ~s")
sym29_0)))
(|#%app|
make-exn:fail:syntax$1
app_0
(current-continuation-marks)
null)))))))
(if (module-binding? b_0)
(let ((app_0
(if (let ((mpi_0
(module-binding-module
b_0)))
(begin-unsafe
(eq?
top-level-module-path-index
mpi_0)))
ns_0
(module-instance-namespace
(binding->module-instance
b_0
ns_0
(namespace-phase ns_0)
id_0)))))
(let ((app_1
(module-binding-phase b_0)))
(values
app_0
app_1
(module-binding-sym b_0))))
(values
ns_0
(namespace-phase ns_0)
sym29_0))))
(args
(raise-binding-result-arity-error
4
args)))))))
(values ns_0 (namespace-phase ns_0) sym29_0)))
(case-lambda
((var-ns_0 var-phase-level_0 var-sym_0)
(let ((val_0
(namespace-get-variable
var-ns_0
var-phase-level_0
var-sym_0
(lambda ()
(|#%app|
escape_0
(if failure-thunk27_0
failure-thunk27_0
(raise
(let ((app_0
(format
(string-append
"namespace-variable-value: given name is not defined\n"
" name: ~s")
sym29_0)))
(|#%app|
exn:fail:contract:variable
app_0
(current-continuation-marks)
sym29_0)))))))))
(lambda () val_0)))
(args
(raise-binding-result-arity-error 3 args))))))))))))))
(|#%name|
namespace-variable-value
(case-lambda
((sym_0)
(begin (namespace-variable-value_0 sym_0 #t #f unsafe-undefined)))
((sym_0 use-mapping?_0 failure-thunk_0 ns28_0)
(namespace-variable-value_0
sym_0
use-mapping?_0
failure-thunk_0
ns28_0))
((sym_0 use-mapping?_0 failure-thunk27_0)
(namespace-variable-value_0
sym_0
use-mapping?_0
failure-thunk27_0
unsafe-undefined))
((sym_0 use-mapping?26_0)
(namespace-variable-value_0
sym_0
use-mapping?26_0
#f
unsafe-undefined))))))
(define 1/namespace-set-variable-value!
(let ((namespace-set-variable-value!_0
(|#%name|
namespace-set-variable-value!
(lambda (sym33_0 val34_0 map?30_0 ns31_0 as-constant?32_0)
(begin
(let ((ns_0
(if (eq? ns31_0 unsafe-undefined)
(1/current-namespace)
ns31_0)))
(begin
(if (symbol? sym33_0)
(void)
(raise-argument-error
'namespace-set-variable-value!
"symbol?"
sym33_0))
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-set-variable-value!
"namespace?"
ns_0))
(namespace-set-variable!
ns_0
(namespace-phase ns_0)
sym33_0
val34_0
as-constant?32_0)
(if map?30_0
(begin
(namespace-unset-transformer!
ns_0
(namespace-phase ns_0)
sym33_0)
(let ((id_0 (1/datum->syntax #f sym33_0)))
(let ((temp101_0
(1/namespace-syntax-introduce id_0 ns_0)))
(let ((temp102_0
(let ((temp104_0 (namespace-mpi ns_0)))
(let ((temp105_0 (namespace-phase ns_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))
(add-binding!.1
#f
#f
temp101_1
temp102_1
temp103_0)))))))
(void)))))))))
(|#%name|
namespace-set-variable-value!
(case-lambda
((sym_0 val_0)
(begin
(namespace-set-variable-value!_0 sym_0 val_0 #f unsafe-undefined #f)))
((sym_0 val_0 map?_0 ns_0 as-constant?32_0)
(namespace-set-variable-value!_0
sym_0
val_0
map?_0
ns_0
as-constant?32_0))
((sym_0 val_0 map?_0 ns31_0)
(namespace-set-variable-value!_0 sym_0 val_0 map?_0 ns31_0 #f))
((sym_0 val_0 map?30_0)
(namespace-set-variable-value!_0
sym_0
val_0
map?30_0
unsafe-undefined
#f))))))
(define 1/namespace-undefine-variable!
(let ((namespace-undefine-variable!_0
(|#%name|
namespace-undefine-variable!
(lambda (sym36_0 ns35_0)
(begin
(let ((ns_0
(if (eq? ns35_0 unsafe-undefined)
(1/current-namespace)
ns35_0)))
(begin
(if (symbol? sym36_0)
(void)
(raise-argument-error
'namespace-undefine-variable!
"symbol?"
sym36_0))
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-undefine-variable!
"namespace?"
ns_0))
(namespace-unset-variable!
ns_0
(namespace-phase ns_0)
sym36_0))))))))
(|#%name|
namespace-undefine-variable!
(case-lambda
((sym_0) (begin (namespace-undefine-variable!_0 sym_0 unsafe-undefined)))
((sym_0 ns35_0) (namespace-undefine-variable!_0 sym_0 ns35_0))))))
(define 1/namespace-mapped-symbols
(let ((namespace-mapped-symbols_0
(|#%name|
namespace-mapped-symbols
(lambda (ns37_0)
(begin
(let ((ns_0
(if (eq? ns37_0 unsafe-undefined)
(1/current-namespace)
ns37_0)))
(begin
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-mapped-symbols
"namespace?"
ns_0))
(set->list
(let ((app_0
(syntax-mapped-names
(let ((v_0 (namespace-get-root-expand-ctx ns_0)))
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner v_0))))
(namespace-phase ns_0))))
(set-union
app_0
(list->set
(instance-variable-names
(begin-unsafe
(definitions-variables
(namespace->definitions ns_0 0)))))))))))))))
(|#%name|
namespace-mapped-symbols
(case-lambda
(() (begin (namespace-mapped-symbols_0 unsafe-undefined)))
((ns37_0) (namespace-mapped-symbols_0 ns37_0))))))
(define 1/namespace-base-phase
(let ((namespace-base-phase_0
(|#%name|
namespace-base-phase
(lambda (ns38_0)
(begin
(let ((ns_0
(if (eq? ns38_0 unsafe-undefined)
(1/current-namespace)
ns38_0)))
(begin
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-base-phase
"namespace?"
ns_0))
(namespace-phase ns_0))))))))
(|#%name|
namespace-base-phase
(case-lambda
(() (begin (namespace-base-phase_0 unsafe-undefined)))
((ns38_0) (namespace-base-phase_0 ns38_0))))))
(define 1/eval
(let ((eval_0
(|#%name|
eval
(lambda (s3_0 ns1_0 compile2_0)
(begin
(let ((ns_0
(if (eq? ns1_0 unsafe-undefined)
(1/current-namespace)
ns1_0)))
(let ((compile_0
(if (eq? compile2_0 unsafe-undefined)
(|#%name|
compile
(lambda (s_0 ns_1) (begin (1/compile s_0 ns_1 #f))))
compile2_0)))
(if (let ((or-part_0 (compiled-in-memory? s3_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (linklet-directory?$1 s3_0)))
(if or-part_1 or-part_1 (linklet-bundle? s3_0)))))
(eval-compiled s3_0 ns_0)
(if (if (syntax?$1 s3_0)
(let ((or-part_0
(compiled-in-memory? (1/syntax-e s3_0))))
(if or-part_0
or-part_0
(let ((or-part_1
(linklet-directory?$1 (1/syntax-e s3_0))))
(if or-part_1
or-part_1
(linklet-bundle? (1/syntax-e s3_0))))))
#f)
(eval-compiled (1/syntax->datum s3_0) ns_0)
(let ((temp65_0
(lambda (s_0 ns_1 tail?_0)
(eval-compiled
(|#%app| compile_0 s_0 ns_1)
ns_1
tail?_0))))
(per-top-level.1
#f
#f
#f
#t
#f
temp65_0
#f
s3_0
ns_0)))))))))))
(|#%name|
eval
(case-lambda
((s_0) (begin (eval_0 s_0 unsafe-undefined unsafe-undefined)))
((s_0 ns_0 compile2_0) (eval_0 s_0 ns_0 compile2_0))
((s_0 ns1_0) (eval_0 s_0 ns1_0 unsafe-undefined))))))
(define eval-compiled
(let ((eval-compiled_0
(|#%name|
eval-compiled
(lambda (c5_0 ns6_0 as-tail?4_0)
(begin
(if (1/compiled-module-expression? c5_0)
(eval-module.1 ns6_0 #f #t c5_0)
(eval-top c5_0 ns6_0 eval-compiled as-tail?4_0)))))))
(case-lambda
((c_0 ns_0) (eval-compiled_0 c_0 ns_0 #t))
((c_0 ns_0 as-tail?4_0) (eval-compiled_0 c_0 ns_0 as-tail?4_0)))))
(define 1/compile
(let ((compile_0
(|#%name|
compile
(lambda (s10_0 ns7_0 serializable?8_0 expand9_0)
(begin
(let ((ns_0
(if (eq? ns7_0 unsafe-undefined)
(1/current-namespace)
ns7_0)))
(let ((expand_0
(if (eq? expand9_0 unsafe-undefined)
expand$1
expand9_0)))
(let ((to-correlated-linklet?_0
(if serializable?8_0
(not (current-compile-target-machine))
#f)))
(let ((cs_0
(if (1/compiled-expression? s10_0)
(list s10_0)
(if (if (syntax?$1 s10_0)
(1/compiled-expression? (1/syntax-e s10_0))
#f)
(list (1/syntax-e s10_0))
(let ((temp71_0
(lambda (s_0 ns_1 as-tail?_0)
(list
(compile-single.1
serializable?8_0
to-correlated-linklet?_0
s_0
ns_1
expand_0)))))
(per-top-level.1
append
#f
#f
#t
#f
temp71_0
#f
s10_0
ns_0))))))
(if (if (= 1 (length cs_0))
(not (compiled-multiple-top? (car cs_0)))
#f)
(car cs_0)
(compiled-tops->compiled-top.1
serializable?8_0
ns_0
to-correlated-linklet?_0
cs_0)))))))))))
(|#%name|
compile
(case-lambda
((s_0) (begin (compile_0 s_0 unsafe-undefined #t unsafe-undefined)))
((s_0 ns_0 serializable?_0 expand9_0)
(compile_0 s_0 ns_0 serializable?_0 expand9_0))
((s_0 ns_0 serializable?8_0)
(compile_0 s_0 ns_0 serializable?8_0 unsafe-undefined))
((s_0 ns7_0) (compile_0 s_0 ns7_0 #t unsafe-undefined))))))
(define struct:lifted-parsed-begin
(make-record-type-descriptor*
'lifted-parsed-begin
#f
(|#%nongenerative-uid| lifted-parsed-begin)
#f
#f
2
0))
(define effect_2903
(struct-type-install-properties!
struct:lifted-parsed-begin
'lifted-parsed-begin
2
0
#f
null
(current-inspector)
#f
'(0 1)
#f
'lifted-parsed-begin))
(define lifted-parsed-begin11.1
(|#%name|
lifted-parsed-begin
(record-constructor
(make-record-constructor-descriptor struct:lifted-parsed-begin #f #f))))
(define lifted-parsed-begin?_2302
(|#%name|
lifted-parsed-begin?
(record-predicate struct:lifted-parsed-begin)))
(define lifted-parsed-begin?
(|#%name|
lifted-parsed-begin?
(lambda (v)
(if (lifted-parsed-begin?_2302 v)
#t
($value
(if (impersonator? v)
(lifted-parsed-begin?_2302 (impersonator-val v))
#f))))))
(define lifted-parsed-begin-seq_2038
(|#%name|
lifted-parsed-begin-seq
(record-accessor struct:lifted-parsed-begin 0)))
(define lifted-parsed-begin-seq
(|#%name|
lifted-parsed-begin-seq
(lambda (s)
(if (lifted-parsed-begin?_2302 s)
(lifted-parsed-begin-seq_2038 s)
($value
(impersonate-ref
lifted-parsed-begin-seq_2038
struct:lifted-parsed-begin
0
s
'lifted-parsed-begin
'seq))))))
(define lifted-parsed-begin-last_2385
(|#%name|
lifted-parsed-begin-last
(record-accessor struct:lifted-parsed-begin 1)))
(define lifted-parsed-begin-last
(|#%name|
lifted-parsed-begin-last
(lambda (s)
(if (lifted-parsed-begin?_2302 s)
(lifted-parsed-begin-last_2385 s)
($value
(impersonate-ref
lifted-parsed-begin-last_2385
struct:lifted-parsed-begin
1
s
'lifted-parsed-begin
'last))))))
(define compile-single.1
(|#%name|
compile-single
(lambda (serializable?12_0
to-correlated-linklet?13_0
s16_0
ns17_0
expand18_0)
(begin
(let ((exp-s_0
(|#%app|
expand18_0
s16_0
ns17_0
#f
#t
serializable?12_0
to-correlated-linklet?13_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (exp-s_1)
(begin
(if (parsed-module? exp-s_1)
(let ((temp85_0
(make-compile-context.1
#f
unsafe-undefined
#f
ns17_0
unsafe-undefined
unsafe-undefined)))
(compile-module.1
#f
unsafe-undefined
#t
serializable?12_0
to-correlated-linklet?13_0
exp-s_1
temp85_0))
(if (lifted-parsed-begin? exp-s_1)
(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))))))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((e_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(loop_0 e_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
(compiled-tops->compiled-top.1
#f
#f
to-correlated-linklet?13_0
temp90_0))
(let ((temp92_0
(make-compile-context.1
#f
unsafe-undefined
#f
ns17_0
unsafe-undefined
unsafe-undefined)))
(compile-top.1
serializable?12_0
#f
to-correlated-linklet?13_0
exp-s_1
temp92_0)))))))))
(loop_0 exp-s_0)))))))
(define expand$1
(let ((expand_0
(|#%name|
expand
(lambda (s25_0
ns20_0
observable?21_0
to-parsed?22_0
serializable?23_0
to-correlated-linklet?24_0)
(begin
(let ((ns_0
(if (eq? ns20_0 unsafe-undefined)
(1/current-namespace)
ns20_0)))
(let ((observer_0
(if observable?21_0 (current-expand-observe) #f)))
(begin
(if observer_0
(call-expand-observe observer_0 'start-top)
(void))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
current-expand-observe
#f)
(let ((temp98_0
(lambda (s_0 ns_1 as-tail?_0)
(expand-single.1
serializable?23_0
to-correlated-linklet?24_0
s_0
ns_1
observer_0
to-parsed?22_0))))
(per-top-level.1
cons
#f
observer_0
#t
#f
temp98_0
re-pair
s25_0
ns_0)))))))))))
(|#%name|
expand
(case-lambda
((s_0) (begin (expand_0 s_0 unsafe-undefined #f #f #f #f)))
((s_0
ns_0
observable?_0
to-parsed?_0
serializable?_0
to-correlated-linklet?24_0)
(expand_0
s_0
ns_0
observable?_0
to-parsed?_0
serializable?_0
to-correlated-linklet?24_0))
((s_0 ns_0 observable?_0 to-parsed?_0 serializable?23_0)
(expand_0 s_0 ns_0 observable?_0 to-parsed?_0 serializable?23_0 #f))
((s_0 ns_0 observable?_0 to-parsed?22_0)
(expand_0 s_0 ns_0 observable?_0 to-parsed?22_0 #f #f))
((s_0 ns_0 observable?21_0) (expand_0 s_0 ns_0 observable?21_0 #f #f #f))
((s_0 ns20_0) (expand_0 s_0 ns20_0 #f #f #f #f))))))
(define expand-single.1
(|#%name|
expand-single
(lambda (serializable?26_0
to-correlated-linklet?27_0
s30_0
ns31_0
observer32_0
to-parsed?33_0)
(begin
(let ((rebuild-s_0 (keep-properties-only s30_0)))
(let ((ctx_0
(make-expand-context.1
serializable?26_0
observer32_0
#f
to-correlated-linklet?27_0
to-parsed?33_0
ns31_0)))
(call-with-values
(lambda () (expand-capturing-lifts s30_0 ctx_0))
(case-lambda
((require-lifts_0 lifts_0 exp-s_0)
(if (if (null? require-lifts_0) (null? lifts_0) #f)
exp-s_0
(if to-parsed?33_0
(let ((temp117_0
(lambda (form_0)
(expand-single.1
serializable?26_0
#f
form_0
ns31_0
observer32_0
to-parsed?33_0))))
(wrap-lifts-as-lifted-parsed-begin.1
temp117_0
require-lifts_0
lifts_0
exp-s_0
rebuild-s_0))
(let ((new-s_0
(let ((temp128_0 (append require-lifts_0 lifts_0)))
(let ((temp130_0 (namespace-phase ns31_0)))
(let ((temp128_1 temp128_0))
(wrap-lifts-as-begin.1
unsafe-undefined
unsafe-undefined
temp128_1
exp-s_0
temp130_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 'lift-loop new-s_0)
(void)))
(expand-single.1
serializable?26_0
#f
new-s_0
ns31_0
observer32_0
to-parsed?33_0))))))
(args (raise-binding-result-arity-error 3 args))))))))))
(define expand-once$1
(let ((expand-once_0
(|#%name|
expand-once
(lambda (s36_0 ns35_0)
(begin
(let ((ns_0
(if (eq? ns35_0 unsafe-undefined)
(1/current-namespace)
ns35_0)))
(let ((temp133_0
(lambda (s_0 ns_1 as-tail?_0)
(expand-single-once s_0 ns_1))))
(per-top-level.1
cons
#t
#f
#t
#f
temp133_0
re-pair
s36_0
ns_0))))))))
(|#%name|
expand-once
(case-lambda
((s_0) (begin (expand-once_0 s_0 unsafe-undefined)))
((s_0 ns35_0) (expand-once_0 s_0 ns35_0))))))
(define expand-single-once
(lambda (s_0 ns_0)
(call-with-values
(lambda ()
(expand-capturing-lifts
s_0
(let ((v_0 (make-expand-context.1 #f #f #f #f #f ns_0)))
(if (expand-context/outer? v_0)
(let ((the-struct_0 (root-expand-context/outer-inner v_0)))
(let ((inner139_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)
#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))))
(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)
(if (if (null? require-lifts_0) (null? lifts_0) #f)
exp-s_0
(let ((temp141_0 (append require-lifts_0 lifts_0)))
(let ((temp143_0 (namespace-phase ns_0)))
(let ((temp141_1 temp141_0))
(wrap-lifts-as-begin.1
unsafe-undefined
unsafe-undefined
temp141_1
exp-s_0
temp143_0))))))
(args (raise-binding-result-arity-error 3 args))))))
(define expand-to-top-form$1
(let ((expand-to-top-form_0
(|#%name|
expand-to-top-form
(lambda (s38_0 ns37_0)
(begin
(let ((ns_0
(if (eq? ns37_0 unsafe-undefined)
(1/current-namespace)
ns37_0)))
(let ((observer_0 (current-expand-observe)))
(begin
(if observer_0
(call-expand-observe observer_0 'start-top)
(void))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
current-expand-observe
#f)
(per-top-level.1
#f
#f
observer_0
#f
#f
#f
#f
s38_0
ns_0))))))))))
(|#%name|
expand-to-top-form
(case-lambda
((s_0) (begin (expand-to-top-form_0 s_0 unsafe-undefined)))
((s_0 ns37_0) (expand-to-top-form_0 s_0 ns37_0))))))
(define per-top-level.1
(|#%name|
per-top-level
(lambda (combine40_0
just-once?42_0
observer45_0
quick-immediate?43_0
serializable?44_0
single39_0
wrap41_0
given-s53_0
ns54_0)
(begin
(let ((s_0 (maybe-intro given-s53_0 ns54_0)))
(let ((ctx_0 (make-expand-context.1 #f observer45_0 #f #f #f ns54_0)))
(let ((phase_0 (namespace-phase ns54_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1 phase_1 ns_0 as-tail?_0)
(begin
(let ((tl-ctx_0
(if (expand-context/outer? ctx_0)
(let ((the-struct_0
(root-expand-context/outer-inner ctx_0)))
(let ((inner151_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)
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))))
(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?"
ctx_0))))
(let ((wb-s_0 (if just-once?42_0 s_1 #f)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'visit s_1)
(void)))
(call-with-values
(lambda ()
(expand-capturing-lifts
s_1
(if (expand-context/outer? 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)
(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))))
(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?"
tl-ctx_0))))
(case-lambda
((require-lifts_0 lifts_0 exp-s_0)
(let ((disarmed-exp-s_0
(syntax-disarm$1 exp-s_0)))
(if (let ((or-part_0 (pair? require-lifts_0)))
(if or-part_0 or-part_0 (pair? lifts_0)))
(let ((new-s_0
(let ((temp160_0
(append
require-lifts_0
lifts_0)))
(wrap-lifts-as-begin.1
unsafe-undefined
unsafe-undefined
temp160_0
exp-s_0
phase_1))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'lift-loop
new-s_0)
(void)))
(if just-once?42_0
new-s_0
(loop_0
new-s_0
phase_1
ns_0
as-tail?_0))))
(if (not single39_0)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'return
exp-s_0)
(void)))
exp-s_0)
(if (if just-once?42_0
(not (eq? exp-s_0 wb-s_0))
#f)
exp-s_0
(let ((tmp_0
(core-form-sym
disarmed-exp-s_0
phase_1)))
(if (eq? tmp_0 'begin)
(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
'prim-begin
disarmed-exp-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_2
(if (syntax?$1
disarmed-exp-s_0)
(syntax-e$1
disarmed-exp-s_0)
disarmed-exp-s_0)))
(if (pair? s_2)
(let ((begin165_0
(let ((s_3
(car s_2)))
s_3)))
(let ((e166_0
(let ((s_3
(cdr
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-s_0)
flat-s_0))))))
(let ((begin165_1
begin165_0))
(values
begin165_1
e166_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-s_0))))
(case-lambda
((begin163_0 e164_0)
(values
#t
begin163_0
e164_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 begin163_0 e164_0)
(letrec*
((begin-loop_0
(|#%name|
begin-loop
(lambda (es_0)
(begin
(if (null? es_0)
(if combine40_0
null
(void))
(if (if (not
combine40_0)
(null?
(cdr es_0))
#f)
(loop_0
(car es_0)
phase_1
ns_0
as-tail?_0)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'next)
(void)))
(let ((a_0
(if combine40_0
(loop_0
(car
es_0)
phase_1
ns_0
#f)
(begin
(loop_0
(car
es_0)
phase_1
ns_0
#f)
(void)))))
(if combine40_0
(|#%app|
combine40_0
a_0
(begin-loop_0
(cdr es_0)))
(begin-loop_0
(cdr
es_0))))))))))))
(if wrap41_0
(let ((new-s_0
(|#%app|
wrap41_0
begin163_0
exp-s_0
(begin-loop_0
e164_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'return
new-s_0)
(void)))
new-s_0))
(begin-loop_0 e164_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
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'prim-begin-for-syntax
disarmed-exp-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_2
(if (syntax?$1
disarmed-exp-s_0)
(syntax-e$1
disarmed-exp-s_0)
disarmed-exp-s_0)))
(if (pair? s_2)
(let ((begin-for-syntax169_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((e170_0
(let ((s_3
(cdr
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-s_0)
flat-s_0))))))
(let ((begin-for-syntax169_1
begin-for-syntax169_0))
(values
begin-for-syntax169_1
e170_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-s_0))))
(case-lambda
((begin-for-syntax167_0
e168_0)
(values
#t
begin-for-syntax167_0
e168_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
begin-for-syntax167_0
e168_0)
(let ((next-phase_0
(add1 phase_1)))
(let ((next-ns_0
(namespace->namespace-at-phase
ns_0
next-phase_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'prepare-env)
(void)))
(begin
(if quick-immediate?43_0
(namespace-visit-available-modules!
ns_0)
(void))
(begin
(namespace-visit-available-modules!
next-ns_0)
(let ((l_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((s_2
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'next)
(void)))
(loop_0
s_2
next-phase_0
next-ns_0
#f))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
e168_0))))))
(if wrap41_0
(let ((new-s_0
(|#%app|
wrap41_0
begin-for-syntax167_0
exp-s_0
l_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
tl-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'return
new-s_0)
(void)))
new-s_0))
(if combine40_0
(apply
append
l_0)
(void))))))))))
(args
(raise-binding-result-arity-error
3
args)))))
(|#%app|
single39_0
exp-s_0
ns_0
as-tail?_0)))))))))
(args
(raise-binding-result-arity-error
3
args))))))))))))
(loop_0 s_0 phase_0 ns54_0 #t)))))))))
(define maybe-intro
(lambda (s_0 ns_0)
(if (syntax?$1 s_0)
s_0
(1/namespace-syntax-introduce (1/datum->syntax #f s_0) ns_0))))
(define re-pair
(lambda (form-id_0 s_0 r_0)
(syntax-rearm$1
(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)
(begin
(if log-performance? (start-performance-region 'expand 'top) (void))
(begin0
(let ((ns_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))))
(begin
(namespace-visit-available-modules! ns_0)
(let ((lift-ctx_0
(let ((temp171_0 (make-top-level-lift ctx_0)))
(make-lift-context.1 #f temp171_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))
(begin-unsafe
(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 ((the-struct_0
(root-expand-context/outer-inner
ctx_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)
(lambda (s_0 phase_0)
(call-with-values
(lambda ()
(let ((s_1 (syntax-disarm$1 s_0)))
(call-with-values
(lambda ()
(let ((s_2 (if (syntax?$1 s_1) (syntax-e$1 s_1) s_1)))
(if (pair? s_2)
(let ((|#%require180_0| (let ((s_3 (car s_2))) s_3)))
(let ((req181_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 ((req182_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"
s_1)))))
(case-lambda
(()
(let ((req182_1 req182_0))
(values req182_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
s_1))))))
(let ((|#%require180_1| |#%require180_0|))
(values |#%require180_1| req181_0))))
(raise-syntax-error$1 #f "bad syntax" s_1))))
(case-lambda
((|#%require178_0| req179_0)
(values #t |#%require178_0| req179_0))
(args (raise-binding-result-arity-error 2 args))))))
(case-lambda
((ok?_0 |#%require178_0| req179_0)
(let ((temp183_0 (list req179_0)))
(let ((temp188_0 (make-requires+provides.1 #f #f)))
(let ((temp183_1 temp183_0))
(parse-and-perform-requires!.1
#f
#f
hash2610
#f
phase_0
#f
#f
#f
#t
'require
temp183_1
s_0
ns_0
phase_0
temp188_0)))))
(args (raise-binding-result-arity-error 3 args)))))))
(define wrap-lifts-as-lifted-parsed-begin.1
(|#%name|
wrap-lifts-as-lifted-parsed-begin
(lambda (adjust-form56_0
require-lifts58_0
lifts59_0
exp-s60_0
rebuild-s61_0)
(begin
(lifted-parsed-begin11.1
(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 ((req_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(cons
(parsed-require23.1 req_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 require-lifts58_0))))))
(append
app_0
(reverse$1
(let ((lst_0 (get-lifts-as-lists lifts59_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((ids+syms+rhs_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((exp-rhs_0
(|#%app|
adjust-form56_0
(caddr ids+syms+rhs_0))))
(let ((just-rhs_0
(if (lifted-parsed-begin?
exp-rhs_0)
(lifted-parsed-begin-last
exp-rhs_0)
exp-rhs_0)))
(let ((dv_0
(let ((app_1
(car
ids+syms+rhs_0)))
(parsed-define-values19.1
rebuild-s61_0
app_1
(cadr
ids+syms+rhs_0)
just-rhs_0))))
(if (lifted-parsed-begin?
exp-rhs_0)
(if (lifted-parsed-begin?
exp-rhs_0)
(lifted-parsed-begin11.1
(lifted-parsed-begin-seq
exp-rhs_0)
dv_0)
(raise-argument-error
'struct-copy
"lifted-parsed-begin?"
exp-rhs_0))
dv_0))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
exp-s60_0)))))
(define replace-me
(lambda (who_0) (lambda args_0 (error who_0 "this stub must be replaced"))))
(define 1/current-eval
(make-parameter
(replace-me 'current-eval)
(lambda (p_0)
(begin
(if (if (procedure? p_0) (procedure-arity-includes? p_0 1) #f)
(void)
(raise-argument-error
'current-eval
"(procedure-arity-includes/c 1)"
p_0))
p_0))
'current-eval))
(define 1/current-compile
(make-parameter
(replace-me 'current-compile)
(lambda (p_0)
(begin
(if (if (procedure? p_0) (procedure-arity-includes? p_0 2) #f)
(void)
(raise-argument-error
'current-compile
"(procedure-arity-includes/c 2)"
p_0))
p_0))
'current-compile))
(define 1/current-load
(make-parameter
(replace-me 'current-load)
(lambda (p_0)
(begin
(if (if (procedure? p_0) (procedure-arity-includes? p_0 2) #f)
(void)
(raise-argument-error
'current-load
"(procedure-arity-includes/c 2)"
p_0))
p_0))
'current-load))
(define 1/current-load/use-compiled
(make-parameter
(replace-me 'current-load/use-compiled)
(lambda (p_0)
(begin
(if (if (procedure? p_0) (procedure-arity-includes? p_0 2) #f)
(void)
(raise-argument-error
'current-load/use-compiled
"(procedure-arity-includes/c 2)"
p_0))
p_0))
'current-load/use-compiled))
(define 1/current-library-collection-paths
(make-parameter
null
(lambda (l_0)
(begin
(if (if (list? l_0) (andmap_2344 complete-path-string? l_0) #f)
(void)
(raise-argument-error
'current-library-collection-paths
"(listof (and/c path-string? complete-path?))"
l_0))
(map_1346 to-path l_0)))
'current-library-collection-paths))
(define 1/current-library-collection-links
(make-parameter
null
(lambda (l_0)
(begin
(if (if (list? l_0)
(andmap_2344
(lambda (p_0)
(let ((or-part_0 (not p_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (|#%app| complete-path-string? p_0)))
(if or-part_1
or-part_1
(if (hash? p_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 p_0 i_0))
(case-lambda
((k_0 v_0)
(let ((result_1
(let ((result_1
(if (let ((or-part_2
(not k_0)))
(if or-part_2
or-part_2
(if (symbol?
k_0)
(1/module-path?
k_0)
#f)))
(if (list? v_0)
(andmap_2344
complete-path-string?
v_0)
#f)
#f)))
(values result_1))))
(if (if (not
(let ((x_0 (list k_0 v_0)))
(not result_1)))
#t
#f)
(for-loop_0
result_1
(hash-iterate-next p_0 i_0))
result_1)))
(args
(raise-binding-result-arity-error
2
args))))
result_0))))))
(for-loop_0 #t (hash-iterate-first p_0))))
#f))))))
l_0)
#f)
(void)
(raise-argument-error
'current-library-collection-links
(string-append
"(listof (or/c #f\n"
" (and/c path-string? complete-path?)\n"
" (hash/c (or/c (and/c symbol? module-path?) #f)\n"
" (listof (and/c path-string? complete-path?)))))")
l_0))
(map_1346
(lambda (p_0)
(if (not p_0)
#f
(if (path? p_0)
p_0
(if (string? p_0)
(string->path p_0)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda () (hash-iterate-key+value p_0 i_0))
(case-lambda
((k_0 v_0)
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(values
k_0
(|#%app| to-path v_0)))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next p_0 i_0))))
(args
(raise-binding-result-arity-error 2 args))))
table_0))))))
(for-loop_0 hash2725 (hash-iterate-first p_0))))))))
l_0)))
'current-library-collection-links))
(define 1/use-compiled-file-paths
(make-parameter
(list (string->path "compiled"))
(lambda (l_0)
(begin
(if (if (list? l_0) (andmap_2344 relative-path-string?$1 l_0) #f)
(void)
(raise-argument-error
'use-compiled-file-paths
"(listof (and/c path-string? relative-path?))"
l_0))
(map_1346 to-path l_0)))
'use-compiled-file-paths))
(define 1/current-compiled-file-roots
(make-parameter
'(same)
(lambda (l_0)
(begin
(if (if (list? l_0)
(andmap_2344
(lambda (p_0)
(let ((or-part_0 (path-string? p_0)))
(if or-part_0 or-part_0 (eq? p_0 'same))))
l_0)
#f)
(void)
(raise-argument-error
'current-compiled-file-roots
"(listof (or/c path-string? 'same))"
l_0))
(map_1346 to-path l_0)))
'current-compiled-file-roots))
(define 1/use-compiled-file-check
(make-parameter
'modify-seconds
(lambda (v_0)
(begin
(if (let ((or-part_0 (eq? v_0 'modify-seconds)))
(if or-part_0 or-part_0 (eq? v_0 'exists)))
(void)
(raise-argument-error
'use-compiled-file-check
"(or/c 'modify-seconds 'exists)"
v_0))
v_0))
'use-compiled-file-check))
(define 1/use-collection-link-paths
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'use-collection-link-paths))
(define 1/use-user-specific-search-paths
(make-parameter
#t
(lambda (v_0) (if v_0 #t #f))
'use-user-specific-search-paths))
(define complete-path-string?
(lambda (p_0) (if (path-string? p_0) (complete-path? p_0) #f)))
(define relative-path-string?$1
(|#%name|
relative-path-string?
(lambda (p_0) (begin (if (path-string? p_0) (relative-path? p_0) #f)))))
(define to-path (lambda (p_0) (if (string? p_0) (string->path p_0) p_0)))
(define eval$1
(|#%name|
eval
(case-lambda
((s_0)
(begin (let ((app_0 (1/current-eval))) (|#%app| app_0 (intro s_0)))))
((s_0 ns_0)
(begin
(if (1/namespace? ns_0)
(void)
(raise-argument-error 'eval "namespace?" ns_0))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
ns_0)
(let ((app_0 (1/current-eval))) (|#%app| app_0 (intro s_0 ns_0)))))))))
(define 1/eval-syntax
(|#%name|
eval-syntax
(case-lambda
((s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'eval-syntax "syntax?" s_0))
(|#%app| (1/current-eval) s_0))))
((s_0 ns_0)
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'eval-syntax "syntax?" s_0))
(if (1/namespace? ns_0)
(void)
(raise-argument-error 'eval-syntax "namespace?" ns_0))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
ns_0)
(|#%app| (1/current-eval) s_0)))))))
(define compile$1
(|#%name|
compile
(lambda (s_0)
(begin
(let ((app_0 (1/current-compile))) (|#%app| app_0 (intro s_0) #f))))))
(define 1/compile-syntax
(|#%name|
compile-syntax
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'compile-syntax "syntax?" s_0))
(|#%app| (1/current-compile) s_0 #f))))))
(define 1/expand
(|#%name|
expand
(lambda (s_0)
(begin
(let ((app_0 (intro s_0)))
(expand$1 app_0 (1/current-namespace) #t))))))
(define 1/expand-syntax
(|#%name|
expand-syntax
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'expand-syntax "syntax?" s_0))
(expand$1 s_0 (1/current-namespace) #t))))))
(define 1/expand-once
(|#%name| expand-once (lambda (s_0) (begin (expand-once$1 (intro s_0))))))
(define 1/expand-syntax-once
(|#%name|
expand-syntax-once
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'expand-syntax-once "syntax?" s_0))
(expand-once$1 s_0))))))
(define 1/expand-to-top-form
(|#%name|
expand-to-top-form
(lambda (s_0) (begin (expand-to-top-form$1 (intro s_0))))))
(define 1/expand-syntax-to-top-form
(|#%name|
expand-syntax-to-top-form
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'expand-syntax-to-top-form "syntax?" s_0))
(expand-to-top-form$1 s_0))))))
(define intro
(let ((intro_0
(|#%name|
intro
(lambda (given-s2_0 ns1_0)
(begin
(let ((ns_0
(if (eq? ns1_0 unsafe-undefined)
(1/current-namespace)
ns1_0)))
(let ((s_0
(if (syntax?$1 given-s2_0)
given-s2_0
(1/datum->syntax #f given-s2_0))))
(1/namespace-syntax-introduce s_0 ns_0))))))))
(case-lambda
((given-s_0) (intro_0 given-s_0 unsafe-undefined))
((given-s_0 ns1_0) (intro_0 given-s_0 ns1_0)))))
(define do-dynamic-require
(let ((do-dynamic-require_0
(|#%name|
do-dynamic-require
(lambda (who2_0 mod-path3_0 sym4_0 fail-k1_0)
(begin
(let ((fail-k_0
(if (eq? fail-k1_0 unsafe-undefined)
default-dynamic-require-fail-thunk
fail-k1_0)))
(begin
(if (let ((or-part_0 (1/module-path? mod-path3_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (1/module-path-index? mod-path3_0)))
(if or-part_1
or-part_1
(1/resolved-module-path? mod-path3_0)))))
(void)
(raise-argument-error
who2_0
"(or/c module-path? module-path-index? resolved-module-path?)"
mod-path3_0))
(begin
(if (let ((or-part_0 (symbol? sym4_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (not sym4_0)))
(if or-part_1
or-part_1
(let ((or-part_2 (eq? sym4_0 0)))
(if or-part_2 or-part_2 (void? sym4_0)))))))
(void)
(raise-argument-error
who2_0
"(or/c symbol? #f 0 void?)"
sym4_0))
(begin
(if (if (procedure? fail-k_0)
(procedure-arity-includes? fail-k_0 0)
#f)
(void)
(raise-argument-error who2_0 "(-> any)" fail-k_0))
(let ((ns_0 (1/current-namespace)))
(let ((mpi_0
(if (1/module-path? mod-path3_0)
(1/module-path-index-join mod-path3_0 #f)
(if (1/module-path-index? mod-path3_0)
mod-path3_0
(1/module-path-index-join
(resolved-module-path->module-path
mod-path3_0)
#f)))))
(let ((mod-name_0
(1/module-path-index-resolve mpi_0 #t)))
(let ((phase_0 (namespace-phase ns_0)))
(if (not sym4_0)
(namespace-module-instantiate!.1
#f
phase_0
hash2610
null
#f
ns_0
mpi_0
phase_0)
(if (eq? sym4_0 0)
(namespace-module-instantiate!.1
#t
phase_0
hash2610
null
#f
ns_0
mpi_0
phase_0)
(if (void? sym4_0)
(begin
(namespace-visit-available-modules!
ns_0
phase_0)
(namespace-module-visit!.1
phase_0
ns_0
mpi_0
phase_0))
(let ((m_0
(namespace->module
ns_0
mod-name_0)))
(begin
(if m_0
(void)
(begin-unsafe
(raise-arguments-error
'dynamic-require
"unknown module"
"module name"
(module-name->error-string
mod-name_0))))
(let ((binding/p_0
(hash-ref
(hash-ref
(module-provides m_0)
0
hash2610)
sym4_0
#f)))
(if (not binding/p_0)
(if (eq?
fail-k_0
default-dynamic-require-fail-thunk)
(raise-arguments-error
'dynamic-require
"name is not provided"
"name"
sym4_0
"module"
mod-name_0)
(|#%app| fail-k_0))
(let ((binding_0
(provided-as-binding
binding/p_0)))
(let ((ex-sym_0
(module-binding-sym
binding_0)))
(let ((ex-phase_0
(module-binding-phase
binding_0)))
(begin
(namespace-module-instantiate!.1
#f
phase_0
hash2610
null
#f
ns_0
mpi_0
phase_0)
(let ((ex-mod-name_0
(1/module-path-index-resolve
(module-path-index-shift
(module-binding-module
binding_0)
(module-self m_0)
mpi_0))))
(let ((m-ns_0
(let ((temp31_0
(phase-
phase_0
ex-phase_0)))
(namespace->module-namespace.1
#f
#t
void
ns_0
ex-mod-name_0
temp31_0))))
(let ((ex-m_0
(namespace->module
ns_0
ex-mod-name_0)))
(let ((access_0
(let ((or-part_0
(module-access
ex-m_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))
#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
(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))))))))))))))))))))))))))))))))))))))))
(case-lambda
((who_0 mod-path_0 sym_0)
(do-dynamic-require_0 who_0 mod-path_0 sym_0 unsafe-undefined))
((who_0 mod-path_0 sym_0 fail-k1_0)
(do-dynamic-require_0 who_0 mod-path_0 sym_0 fail-k1_0)))))
(define default-dynamic-require-fail-thunk (lambda () (error "failed")))
(define 1/dynamic-require
(let ((dynamic-require_0
(|#%name|
dynamic-require
(lambda (mod-path6_0 sym7_0 fail-k5_0)
(begin
(let ((fail-k_0
(if (eq? fail-k5_0 unsafe-undefined)
default-dynamic-require-fail-thunk
fail-k5_0)))
(do-dynamic-require
'dynamic-require
mod-path6_0
sym7_0
fail-k_0)))))))
(|#%name|
dynamic-require
(case-lambda
((mod-path_0 sym_0)
(begin (dynamic-require_0 mod-path_0 sym_0 unsafe-undefined)))
((mod-path_0 sym_0 fail-k5_0)
(dynamic-require_0 mod-path_0 sym_0 fail-k5_0))))))
(define 1/dynamic-require-for-syntax
(let ((dynamic-require-for-syntax_0
(|#%name|
dynamic-require-for-syntax
(lambda (mod-path9_0 sym10_0 fail-k8_0)
(begin
(let ((fail-k_0
(if (eq? fail-k8_0 unsafe-undefined)
default-dynamic-require-fail-thunk
fail-k8_0)))
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first #f parameterization-key)))
(extend-parameterization
app_0
1/current-namespace
(let ((ns_0 (1/current-namespace)))
(namespace->namespace-at-phase
ns_0
(add1 (namespace-phase ns_0))))))
(do-dynamic-require
'dynamic-require-for-syntax
mod-path9_0
sym10_0
fail-k_0))))))))
(|#%name|
dynamic-require-for-syntax
(case-lambda
((mod-path_0 sym_0)
(begin
(dynamic-require-for-syntax_0 mod-path_0 sym_0 unsafe-undefined)))
((mod-path_0 sym_0 fail-k8_0)
(dynamic-require-for-syntax_0 mod-path_0 sym_0 fail-k8_0))))))
(define 1/load
(|#%name|
load
(lambda (s_0)
(begin
(begin
(if (path-string? s_0)
(void)
(raise-argument-error 'load "path-string?" s_0))
(let ((p_0 (->path s_0)))
(call-with-current-load-relative-directory
p_0
(lambda () (|#%app| (1/current-load) p_0 #f)))))))))
(define 1/load-extension
(|#%name|
load-extension
(lambda (s_0)
(begin
(begin
(if (path-string? s_0)
(void)
(raise-argument-error 'load-extension "path-string?" s_0))
(let ((p_0 (->path s_0)))
(call-with-current-load-relative-directory
p_0
(lambda () (|#%app| (current-load-extension) p_0 #f)))))))))
(define call-with-current-load-relative-directory
(lambda (p_0 thunk_0)
(call-with-values
(lambda () (split-path p_0))
(case-lambda
((base_0 name_0 dir?_0)
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0 (continuation-mark-set-first #f parameterization-key)))
(extend-parameterization
app_0
current-load-relative-directory
(if (eq? base_0 'relative)
(current-directory)
(path->complete-path base_0))))
(|#%app| thunk_0)))
(args (raise-binding-result-arity-error 3 args))))))
(define 1/load/use-compiled
(|#%name|
load/use-compiled
(lambda (f_0)
(begin
(begin
(if (path-string? f_0)
(void)
(raise-argument-error 'load/use-compiled "path-string?" f_0))
(let ((p_0 (->path f_0)))
(|#%app| (1/current-load/use-compiled) p_0 #f)))))))
(define embedded-load
(let ((embedded-load_0
(|#%name|
embedded-load
(lambda (start2_0 end3_0 bstr4_0 as-predefined?5_0 in-path1_0)
(begin
(let ((s_0
(if bstr4_0
bstr4_0
(let ((path_0
(if (bytes? in-path1_0)
(bytes->path in-path1_0)
(if (string? in-path1_0)
in-path1_0
(find-executable-path
(find-system-path 'exec-file)
#f)))))
(let ((start_0
(if (string? start2_0)
(let ((or-part_0
(|#%app| 1/string->number start2_0)))
(if or-part_0 or-part_0 0))
start2_0)))
(let ((end_0
(if (string? end3_0)
(let ((or-part_0
(|#%app| 1/string->number end3_0)))
(if or-part_0 or-part_0 0))
(if end3_0 end3_0 (file-size path_0)))))
(let ((temp10_0
(|#%name|
temp10
(lambda ()
(begin
(begin
(file-position
(current-input-port)
start_0)
(read-bytes
(max 0 (- end_0 start_0)))))))))
(with-input-from-file.1
'binary
path_0
temp10_0))))))))
(let ((p_0 (open-input-bytes s_0)))
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((e_0
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/read-accept-compiled
#t
1/read-accept-reader
#t
1/read-accept-lang
#t
read-on-demand-source
#t)
(1/read p_0))))
(if (eof-object? e_0)
(void)
(begin
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
current-module-declare-as-predefined
as-predefined?5_0)
(|#%app| (1/current-eval) e_0))
(loop_0)))))))))
(loop_0)))))))))
(case-lambda
((start_0 end_0 bstr_0 as-predefined?_0)
(embedded-load_0 start_0 end_0 bstr_0 as-predefined?_0 #f))
((start_0 end_0 bstr_0 as-predefined?_0 in-path1_0)
(embedded-load_0 start_0 end_0 bstr_0 as-predefined?_0 in-path1_0)))))
(define ->path (lambda (s_0) (if (string? s_0) (string->path s_0) s_0)))
(define find-main-collects
(lambda ()
(cache-configuration
0
(lambda ()
(exe-relative-path->complete-path (find-system-path 'collects-dir))))))
(define find-main-config
(lambda ()
(cache-configuration
1
(lambda ()
(exe-relative-path->complete-path (find-system-path 'config-dir))))))
(define exe-relative-path->complete-path
(lambda (collects-path_0)
(if (complete-path? collects-path_0)
(simplify-path collects-path_0)
(if (absolute-path? collects-path_0)
(let ((exec_0
(call-in-original-directory
(lambda ()
(let ((app_0
(find-executable-path (find-system-path 'exec-file))))
(path->complete-path
app_0
(find-system-path 'orig-dir)))))))
(call-with-values
(lambda () (split-path exec_0))
(case-lambda
((base_0 name_0 dir?_0)
(simplify-path (path->complete-path collects-path_0 base_0)))
(args (raise-binding-result-arity-error 3 args)))))
(let ((p_0
(call-in-original-directory
(lambda ()
(find-executable-path
(find-system-path 'exec-file)
collects-path_0
#t)))))
(if p_0 (simplify-path p_0) #f))))))
(define call-in-original-directory
(lambda (thunk_0)
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0 (continuation-mark-set-first #f parameterization-key)))
(extend-parameterization
app_0
current-directory
(find-system-path 'orig-dir)))
(|#%app| thunk_0))))
(define struct:shadow-directory
(make-record-type-descriptor*
'shadow-directory
#f
(|#%nongenerative-uid| shadow-directory)
#f
#f
2
0))
(define effect_2127
(struct-type-install-properties!
struct:shadow-directory
'shadow-directory
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'shadow-directory))
(define shadow-directory1.1
(|#%name|
shadow-directory
(record-constructor
(make-record-constructor-descriptor struct:shadow-directory #f #f))))
(define shadow-directory?
(|#%name| shadow-directory? (record-predicate struct:shadow-directory)))
(define shadow-directory-evt
(|#%name| shadow-directory-evt (record-accessor struct:shadow-directory 0)))
(define shadow-directory-table
(|#%name|
shadow-directory-table
(record-accessor struct:shadow-directory 1)))
(define use-shadow-directory?
(let ((v_0 (system-type 'fs-change)))
(if (eq? 'scalable (vector-ref v_0 1))
(eq? 'low-latency (vector-ref v_0 2))
#f)))
(define make-cache (lambda () (if use-shadow-directory? (make-weak-hash) #f)))
(define cell.1$2 (unsafe-make-place-local (make-cache)))
(define shadow-directory-place-init!
(lambda () (unsafe-place-local-set! cell.1$2 (make-cache))))
(define lookup-shadow-directory
(lambda (orig_0)
(let ((sd_0
(call-as-atomic
(lambda ()
(hash-ref (unsafe-place-local-ref cell.1$2) orig_0 #f)))))
(if sd_0
(if (sync/timeout 0 (shadow-directory-evt sd_0))
(begin
(call-as-atomic
(lambda ()
(hash-remove! (unsafe-place-local-ref cell.1$2) orig_0)))
(lookup-shadow-directory orig_0))
sd_0)
(let ((evt_0 (filesystem-change-evt orig_0 (lambda () #f))))
(if evt_0
(let ((table_0
(let ((lst_0 (directory-list orig_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_1)
(begin
(if (pair? lst_1)
(let ((p_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((table_1
(if (directory-exists?
(build-path orig_0 p_0))
(let ((table_1
(call-with-values
(lambda ()
(values
(normal-case-path p_0)
#t))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))
table_0)))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 lst_0))))))
(let ((sd_1 (shadow-directory1.1 evt_0 table_0)))
(begin
(call-as-atomic
(lambda ()
(hash-set!
(unsafe-place-local-ref cell.1$2)
orig_0
sd_1)))
sd_1)))
#f))))))
(define directory-exists?/shadow-filesystem
(lambda (p_0 orig_0 subpath_0)
(if (not (unsafe-place-local-ref cell.1$2))
(directory-exists? p_0)
(let ((sd_0 (lookup-shadow-directory orig_0)))
(if (not sd_0)
(directory-exists? p_0)
(if sd_0
(let ((ht_0 (shadow-directory-table sd_0)))
(hash-ref ht_0 (normal-case-path subpath_0) #f))
(void)))))))
(define relative-path-string?
(lambda (s_0) (if (path-string? s_0) (relative-path? s_0) #f)))
(define check-collection
(lambda (who_0 s_0 l_0)
(begin
(if (relative-path-string? s_0)
(void)
(raise-argument-error who_0 "(and/c path-string? relative-path?)" s_0))
(if (if (list? l_0) (andmap_2344 relative-path-string? l_0) #f)
(void)
(raise-argument-error
who_0
"(listof (and/c path-string? relative-path?))"
l_0)))))
(define check-fail
(lambda (who_0 fail_0)
(if (if (procedure? fail_0) (procedure-arity-includes? fail_0 1) #f)
(void)
(raise-argument-error who_0 "(procedure-arity-includes/c 1)" fail_0))))
(define 1/collection-path
(|#%name|
collection-path
(lambda (fail_0 collection_0 collection-path_0)
(begin
(begin
(check-collection 'collection-path collection_0 collection-path_0)
(check-fail 'collection-path fail_0)
(find-col-file fail_0 collection_0 collection-path_0 #f #f))))))
(define 1/collection-file-path
(|#%name|
collection-file-path
(lambda (fail_0
check-compiled?_0
file-name_0
collection_0
collection-path_0)
(begin
(begin
(if (relative-path-string? file-name_0)
(void)
(raise-argument-error
'collection-file-path
"(and/c path-string? relative-path?)"
file-name_0))
(check-collection
'collection-file-path
collection_0
collection-path_0)
(check-fail 'collection-file-path fail_0)
(find-col-file
fail_0
collection_0
collection-path_0
file-name_0
check-compiled?_0))))))
(define get-config-table
(lambda (d_0)
(let ((p_0 (if d_0 (build-path d_0 "config.rktd") #f)))
(let ((or-part_0
(if p_0
(if (file-exists? p_0)
(let ((temp6_0
(|#%name|
temp6
(lambda ()
(begin
(let ((v_0
(call-with-default-reading-parameterization
1/read)))
(if (hash? v_0) v_0 #f)))))))
(with-input-from-file.1 'binary p_0 temp6_0))
#f)
#f)))
(if or-part_0 or-part_0 hash2725)))))
(define get-installation-name
(lambda (config-table_0)
(hash-ref config-table_0 'installation-name (version))))
(define coerce-to-path
(lambda (p_0)
(if (string? p_0)
(collects-relative-path->complete-path (string->path p_0))
(if (bytes? p_0)
(collects-relative-path->complete-path (bytes->path p_0))
(if (path? p_0) (collects-relative-path->complete-path p_0) p_0)))))
(define collects-relative-path->complete-path
(lambda (p_0)
(if (complete-path? p_0)
p_0
(path->complete-path
p_0
(let ((or-part_0 (find-main-collects)))
(if or-part_0 or-part_0 (current-directory)))))))
(define add-config-search
(lambda (ht_0 key_0 orig-l_0)
(let ((l_0 (hash-ref ht_0 key_0 #f)))
(if l_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? l_1)
null
(if (not (car l_1))
(append orig-l_0 (loop_0 (cdr l_1)))
(let ((app_0 (coerce-to-path (car l_1))))
(cons app_0 (loop_0 (cdr l_1)))))))))))
(loop_0 l_0))
orig-l_0))))
(define 1/find-library-collection-links
(|#%name|
find-library-collection-links
(lambda ()
(begin
(let ((ht_0 (get-config-table (find-main-config))))
(let ((lf_0
(coerce-to-path
(let ((or-part_0 (hash-ref ht_0 'links-file #f)))
(if or-part_0
or-part_0
(build-path
(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 (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))))
(define stamp-prompt-tag (make-continuation-prompt-tag 'stamp))
(define file->stamp
(lambda (path_0 old-stamp_0)
(if (if old-stamp_0
(if (cdr old-stamp_0) (not (sync/timeout 0 (cdr old-stamp_0))) #f)
#f)
old-stamp_0
(call-with-continuation-prompt
(lambda ()
(call-with-exception-handler
(lambda (exn_0)
(abort-current-continuation
stamp-prompt-tag
(if (exn:fail:filesystem? exn_0)
(lambda () #f)
(lambda () (raise exn_0)))))
(lambda ()
(let ((dir-evt_0
(if (vector-ref (system-type 'fs-change) 2)
(letrec*
((loop_0
(|#%name|
loop
(lambda (path_1)
(begin
(call-with-values
(lambda () (split-path path_1))
(case-lambda
((base_0 name_0 dir?_0)
(if (path? base_0)
(if (directory-exists? base_0)
(filesystem-change-evt
base_0
(lambda () #f))
(loop_0 base_0))
#f))
(args
(raise-binding-result-arity-error
3
args)))))))))
(loop_0 path_0))
#f)))
(if (not (file-exists? path_0))
(cons #f dir-evt_0)
(let ((evt_0
(if (vector-ref (system-type 'fs-change) 2)
(filesystem-change-evt path_0 (lambda () #f))
#f)))
(begin
(if dir-evt_0
(filesystem-change-evt-cancel dir-evt_0)
(void))
(cons (file->bytes path_0) evt_0))))))))
stamp-prompt-tag))))
(define file->bytes
(lambda (path_0)
(let ((temp8_0
(|#%name|
temp8
(lambda (p_0)
(begin
(let ((bstr_0 (read-bytes 8192 p_0)))
(if (if (bytes? bstr_0)
(>= (unsafe-bytes-length bstr_0) 8192)
#f)
(apply
bytes-append
(cons
bstr_0
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((bstr_1 (read-bytes 8192 p_0)))
(if (eof-object? bstr_1)
null
(cons bstr_1 (loop_0)))))))))
(loop_0))))
bstr_0)))))))
(call-with-input-file*.1 'binary path_0 temp8_0))))
(define no-file-stamp?
(lambda (a_0)
(let ((or-part_0 (not a_0))) (if or-part_0 or-part_0 (not (car a_0))))))
(define get-linked-collections
(lambda (links-path_0)
(call-with-escape-continuation
(lambda (esc_0)
(let ((make-handler_0
(|#%name|
make-handler
(lambda (ts_0)
(begin
(lambda (exn_0)
(begin
(if (exn:fail? exn_0)
(let ((l_0 (current-logger)))
(if (log-level? l_0 'error)
(let ((app_0
(format
"error reading collection links file ~s: ~a"
links-path_0
(exn-message exn_0))))
(log-message
l_0
'error
app_0
(current-continuation-marks)))
(void)))
(void))
(if ts_0
(call-as-atomic
(lambda ()
(hash-set!
(unsafe-place-local-ref cell.1$1)
links-path_0
(cons ts_0 hash2610))))
(void))
(if (exn:fail? exn_0)
(|#%app| esc_0 (make-hasheq))
exn_0))))))))
(call-with-exception-handler
(make-handler_0 #f)
(lambda ()
(let ((links-stamp+cache_0
(call-as-atomic
(lambda ()
(hash-ref
(unsafe-place-local-ref cell.1$1)
links-path_0
nhash2607)))))
(let ((a-links-stamp_0 (car links-stamp+cache_0)))
(let ((ts_0 (file->stamp links-path_0 a-links-stamp_0)))
(if (equal? ts_0 a-links-stamp_0)
(cdr links-stamp+cache_0)
(call-with-exception-handler
(make-handler_0 ts_0)
(lambda ()
(call-with-default-reading-parameterization
(lambda ()
(let ((v_0
(if (no-file-stamp? ts_0)
null
(let ((temp10_0
(|#%name|
temp10
(lambda (p_0)
(begin
(begin0
(1/read p_0)
(if (eof-object? (1/read p_0))
(void)
(error
"expected a single S-expression"))))))))
(call-with-input-file*.1
'binary
links-path_0
temp10_0)))))
(begin
(if (if (list? v_0)
(andmap_2344
(lambda (p_0)
(if (list? p_0)
(if (let ((or-part_0
(= 2 (length p_0))))
(if or-part_0
or-part_0
(= 3 (length p_0))))
(if (let ((or-part_0
(string? (car p_0))))
(if or-part_0
or-part_0
(let ((or-part_1
(eq?
'root
(car p_0))))
(if or-part_1
or-part_1
(eq?
'static-root
(car p_0))))))
(if (path-string? (cadr p_0))
(let ((or-part_0
(null? (cddr p_0))))
(if or-part_0
or-part_0
(regexp? (caddr p_0))))
#f)
#f)
#f)
#f))
v_0)
#f)
(void)
(error "ill-formed content"))
(let ((ht_0 (make-hasheq)))
(let ((dir_0
(call-with-values
(lambda () (split-path links-path_0))
(case-lambda
((base_0 name_0 dir?_0) base_0)
(args
(raise-binding-result-arity-error
3
args))))))
(begin
(for-each_2380
(lambda (p_0)
(if (let ((or-part_0
(null? (cddr p_0))))
(if or-part_0
or-part_0
(regexp-match?
(caddr p_0)
(version))))
(let ((dir_1
(simplify-path
(path->complete-path
(cadr p_0)
dir_0))))
(if (eq? (car p_0) 'static-root)
(for-each_2380
(lambda (sub_0)
(if (directory-exists?
(build-path dir_1 sub_0))
(let ((k_0
(string->symbol
(path->string
sub_0))))
(hash-set!
ht_0
k_0
(cons
dir_1
(hash-ref
ht_0
k_0
null))))
(void)))
(directory-list dir_1))
(if (eq? (car p_0) 'root)
(begin
(if (hash-ref ht_0 #f #f)
(void)
(hash-set! ht_0 #f null))
(hash-for-each
ht_0
(lambda (k_0 v_1)
(hash-set!
ht_0
k_0
(cons dir_1 v_1)))))
(let ((s_0
(string->symbol
(car p_0))))
(hash-set!
ht_0
s_0
(let ((app_0 (box dir_1)))
(cons
app_0
(hash-ref
ht_0
s_0
null))))))))
(void)))
v_0)
(hash-for-each
ht_0
(lambda (k_0 v_1)
(hash-set! ht_0 k_0 (reverse$1 v_1))))
(call-as-atomic
(lambda ()
(hash-set!
(unsafe-place-local-ref cell.1$1)
links-path_0
(cons ts_0 ht_0))))
ht_0))))))))))))))))))))
(define normalize-collection-reference
(lambda (collection_0 collection-path_0)
(if (string? collection_0)
(let ((m_0 (regexp-match-positions rx2897 collection_0)))
(if m_0
(if (let ((app_0 (caar m_0)))
(= app_0 (sub1 (string-length collection_0))))
(values (substring collection_0 0 (caar m_0)) collection-path_0)
(let ((app_0 (substring collection_0 0 (caar m_0))))
(values
app_0
(cons (substring collection_0 (cdar m_0)) collection-path_0))))
(values collection_0 collection-path_0)))
(call-with-values
(lambda () (split-path collection_0))
(case-lambda
((base_0 name_0 dir?_0)
(if (eq? base_0 'relative)
(values name_0 collection-path_0)
(normalize-collection-reference
base_0
(cons name_0 collection-path_0))))
(args (raise-binding-result-arity-error 3 args)))))))
(define find-col-file
(lambda (fail_0
collection-in_0
collection-path-in_0
file-name_0
check-compiled?_0)
(call-with-values
(lambda ()
(normalize-collection-reference collection-in_0 collection-path-in_0))
(case-lambda
((collection_0 collection-path_0)
(let ((all-paths_0
(let ((sym_0
(string->symbol
(if (path? collection_0)
(path->string collection_0)
collection_0))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_0)
(begin
(if (null? l_0)
null
(if (not (car l_0))
(let ((app_0 (1/current-library-collection-paths)))
(append app_0 (loop_0 (cdr l_0))))
(if (hash? (car l_0))
(let ((app_0
(map_1346
box
(hash-ref (car l_0) sym_0 null))))
(let ((app_1 (hash-ref (car l_0) #f null)))
(append app_0 app_1 (loop_0 (cdr l_0)))))
(let ((ht_0 (get-linked-collections (car l_0))))
(let ((app_0 (hash-ref ht_0 sym_0 null)))
(let ((app_1 (hash-ref ht_0 #f null)))
(append
app_0
app_1
(loop_0 (cdr l_0))))))))))))))
(loop_0 (1/current-library-collection-links))))))
(let ((done_0
(|#%name|
done
(lambda (p_0)
(begin
(if file-name_0 (build-path p_0 file-name_0) p_0))))))
(let ((*build-path-rep_0
(|#%name|
*build-path-rep
(lambda (p_0 c_0)
(begin
(if (path? p_0) (build-path p_0 c_0) (unbox p_0)))))))
(let ((*directory-exists?_0
(|#%name|
*directory-exists?
(lambda (orig_0 collection_1 p_0)
(begin
(if (path? orig_0)
(directory-exists?/shadow-filesystem
p_0
orig_0
collection_1)
#t))))))
(let ((to-string_0
(|#%name|
to-string
(lambda (p_0)
(begin (if (path? p_0) (path->string p_0) p_0))))))
(letrec*
((cloop_0
(|#%name|
cloop
(lambda (paths_0 found-col_0)
(begin
(if (null? paths_0)
(if found-col_0
(done_0 found-col_0)
(let ((rest-coll_0
(if (null? collection-path_0)
""
(apply
string-append
(letrec*
((loop_0
(|#%name|
loop
(lambda (cp_0)
(begin
(if (null? (cdr cp_0))
(list
(to-string_0 (car cp_0)))
(let ((app_0
(to-string_0
(car cp_0))))
(list*
app_0
"/"
(loop_0 (cdr cp_0))))))))))
(loop_0 collection-path_0))))))
(letrec*
((filter_0
(|#%name|
filter
(lambda (f_0 l_0)
(begin
(if (null? l_0)
null
(if (|#%app| f_0 (car l_0))
(let ((app_0 (car l_0)))
(cons
app_0
(filter_0 f_0 (cdr l_0))))
(filter_0 f_0 (cdr l_0)))))))))
(|#%app|
fail_0
(let ((app_0
(if (null? collection-path_0)
(to-string_0 collection_0)
(string-append
(to-string_0 collection_0)
"/"
rest-coll_0))))
(let ((app_1
(apply
string-append
(map_1346
(lambda (p_0)
(format "\n ~a ~a" " " p_0))
(let ((len_0 (length all-paths_0)))
(let ((clen_0
(length
(1/current-library-collection-paths))))
(let ((len_1 len_0))
(if (< (- len_1 clen_0) 5)
all-paths_0
(let ((app_1
(1/current-library-collection-paths)))
(append
app_1
(list
(format
"... [~a additional linked and package directories]"
(-
len_1
clen_0)))))))))))))
(format
"collection not found\n collection: ~s\n in collection directories:~a~a"
app_0
app_1
(if (ormap_2765 box? all-paths_0)
(format
"\n sub-collection: ~s\n in parent directories:~a"
rest-coll_0
(apply
string-append
(map_1346
(lambda (p_0)
(format "\n ~a" (unbox p_0)))
(filter_0 box? all-paths_0))))
""))))))))
(let ((dir_0
(*build-path-rep_0
(car paths_0)
collection_0)))
(if (*directory-exists?_0
(car paths_0)
collection_0
dir_0)
(let ((cpath_0
(apply
build-path
dir_0
collection-path_0)))
(if (if (null? collection-path_0)
#t
(directory-exists? cpath_0))
(if file-name_0
(if (let ((or-part_0
(file-exists?/maybe-compiled
cpath_0
file-name_0
check-compiled?_0)))
(if or-part_0
or-part_0
(let ((alt-file-name_0
(let ((file-name_1
(if (path?
file-name_0)
(path->string
file-name_0)
file-name_0)))
(let ((len_0
(string-length
file-name_1)))
(if (>= len_0 4)
(if (string=?
".rkt"
(substring
file-name_1
(- len_0 4)))
(string-append
(substring
file-name_1
0
(- len_0 4))
".ss")
#f)
#f)))))
(if alt-file-name_0
(file-exists?/maybe-compiled
cpath_0
alt-file-name_0
check-compiled?_0)
#f))))
(done_0 cpath_0)
(let ((app_0 (cdr paths_0)))
(cloop_0
app_0
(if found-col_0
found-col_0
cpath_0))))
(done_0 cpath_0))
(cloop_0 (cdr paths_0) found-col_0)))
(cloop_0 (cdr paths_0) found-col_0)))))))))
(cloop_0 all-paths_0 #f))))))))
(args (raise-binding-result-arity-error 2 args))))))
(define file-exists?/maybe-compiled
(lambda (dir_0 path_0 check-compiled?_0)
(let ((or-part_0 (file-exists? (build-path dir_0 path_0))))
(if or-part_0
or-part_0
(if check-compiled?_0
(let ((sfx_0 #vu8(46 122 111)))
(let ((try-path_0
(begin-unsafe
(path-adjust-extension
'path-add-extension
#vu8(95)
subbytes
path_0
sfx_0
#t))))
(let ((modes_0 (1/use-compiled-file-paths)))
(let ((roots_0 (1/current-compiled-file-roots)))
(let ((modes_1 modes_0) (try-path_1 try-path_0))
(ormap_2765
(lambda (d_0)
(ormap_2765
(lambda (mode_0)
(file-exists?
(let ((p_0 (build-path dir_0 mode_0 try-path_1)))
(if (eq? d_0 'same)
p_0
(if (relative-path? d_0)
(build-path p_0 d_0)
(reroot-path p_0 d_0))))))
modes_1))
roots_0))))))
#f)))))
(define 1/find-library-collection-paths
(let ((find-library-collection-paths_0
(|#%name|
find-library-collection-paths
(lambda (extra-collects-dirs1_0 post-collects-dirs2_0)
(begin
(let ((user-too?_0 (1/use-user-specific-search-paths)))
(let ((cons-if_0
(|#%name|
cons-if
(lambda (f_0 r_0)
(begin (if f_0 (cons f_0 r_0) r_0))))))
(let ((config-table_0 (get-config-table (find-main-config))))
(let ((cons-if_1 cons-if_0) (user-too?_1 user-too?_0))
(let ((app_0
(if user-too?_1
(let ((c_0
(environment-variables-ref
(current-environment-variables)
#vu8(80 76 84 67 79 76 76 69 67 84 83))))
(if c_0 (bytes->string/locale c_0 '#\x3f) ""))
"")))
(path-list-string->path-list
app_0
(add-config-search
config-table_0
'collects-search-dirs
(let ((app_1
(if user-too?_1
(let ((app_1 (find-system-path 'addon-dir)))
(build-path
app_1
(get-installation-name config-table_0)
"collects"))
#f)))
(cons-if_1
app_1
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_0)
(begin
(if (null? l_0)
null
(let ((collects-path_0 (car l_0)))
(let ((v_0
(exe-relative-path->complete-path
collects-path_0)))
(if v_0
(let ((app_2
(simplify-path
(path->complete-path
v_0
(current-directory)))))
(cons app_2 (loop_0 (cdr l_0))))
(loop_0 (cdr l_0)))))))))))
(loop_0
(append
extra-collects-dirs1_0
(list (find-system-path 'collects-dir))
post-collects-dirs2_0)))))))))))))))))
(|#%name|
find-library-collection-paths
(case-lambda
(() (begin (find-library-collection-paths_0 null null)))
((extra-collects-dirs_0 post-collects-dirs2_0)
(find-library-collection-paths_0
extra-collects-dirs_0
post-collects-dirs2_0))
((extra-collects-dirs1_0)
(find-library-collection-paths_0 extra-collects-dirs1_0 null))))))
(define-values
(prop:readtable prop:readtable? prop:readtable-ref)
(make-struct-type-property 'readtable))
(define 1/current-readtable
(make-parameter
#f
(lambda (v_0)
(begin
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (prop:readtable? v_0)))
(void)
(raise-argument-error
'current-readtable
"(or/c prop:readtable? #f)"
v_0))
v_0))
'current-readtable))
(define struct:read-config/outer
(make-record-type-descriptor*
'read-config
#f
(|#%nongenerative-uid| read-config)
#f
#f
7
0))
(define effect_2456
(struct-type-install-properties!
struct:read-config/outer
'read-config
7
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6)
#f
'read-config/outer))
(define read-config/outer1.1
(|#%name|
read-config/outer
(record-constructor
(make-record-constructor-descriptor struct:read-config/outer #f #f))))
(define read-config/outer?
(|#%name| read-config? (record-predicate struct:read-config/outer)))
(define read-config/outer-inner
(|#%name| read-config-inner (record-accessor struct:read-config/outer 0)))
(define read-config/outer-wrap
(|#%name| read-config-wrap (record-accessor struct:read-config/outer 1)))
(define read-config/outer-line
(|#%name| read-config-line (record-accessor struct:read-config/outer 2)))
(define read-config/outer-col
(|#%name| read-config-col (record-accessor struct:read-config/outer 3)))
(define read-config/outer-pos
(|#%name| read-config-pos (record-accessor struct:read-config/outer 4)))
(define read-config/outer-indentations
(|#%name|
read-config-indentations
(record-accessor struct:read-config/outer 5)))
(define read-config/outer-keep-comment?
(|#%name|
read-config-keep-comment?
(record-accessor struct:read-config/outer 6)))
(define struct:read-config/inner
(make-record-type-descriptor*
'read-config/inner
#f
(|#%nongenerative-uid| read-config/inner)
#f
#f
13
0))
(define effect_2332
(struct-type-install-properties!
struct:read-config/inner
'read-config/inner
13
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8 9 10 11 12)
#f
'read-config/inner))
(define read-config/inner2.1
(|#%name|
read-config/inner
(record-constructor
(make-record-constructor-descriptor struct:read-config/inner #f #f))))
(define read-config/inner?
(|#%name| read-config/inner? (record-predicate struct:read-config/inner)))
(define read-config/inner-readtable
(|#%name|
read-config/inner-readtable
(record-accessor struct:read-config/inner 0)))
(define read-config/inner-next-readtable
(|#%name|
read-config/inner-next-readtable
(record-accessor struct:read-config/inner 1)))
(define read-config/inner-for-syntax?
(|#%name|
read-config/inner-for-syntax?
(record-accessor struct:read-config/inner 2)))
(define read-config/inner-source
(|#%name|
read-config/inner-source
(record-accessor struct:read-config/inner 3)))
(define read-config/inner-read-compiled
(|#%name|
read-config/inner-read-compiled
(record-accessor struct:read-config/inner 4)))
(define read-config/inner-call-with-root-namespace
(|#%name|
read-config/inner-call-with-root-namespace
(record-accessor struct:read-config/inner 5)))
(define read-config/inner-dynamic-require
(|#%name|
read-config/inner-dynamic-require
(record-accessor struct:read-config/inner 6)))
(define read-config/inner-module-declared?
(|#%name|
read-config/inner-module-declared?
(record-accessor struct:read-config/inner 7)))
(define read-config/inner-coerce
(|#%name|
read-config/inner-coerce
(record-accessor struct:read-config/inner 8)))
(define read-config/inner-coerce-key
(|#%name|
read-config/inner-coerce-key
(record-accessor struct:read-config/inner 9)))
(define read-config/inner-parameter-override
(|#%name|
read-config/inner-parameter-override
(record-accessor struct:read-config/inner 10)))
(define read-config/inner-parameter-cache
(|#%name|
read-config/inner-parameter-cache
(record-accessor struct:read-config/inner 11)))
(define read-config/inner-st
(|#%name|
read-config/inner-st
(record-accessor struct:read-config/inner 12)))
(define read-config/make
(lambda (readtable_0
next-readtable_0
for-syntax?_0
source_0
wrap_0
read-compiled_0
call-with-root-namespace_0
dynamic-require_0
module-declared?_0
coerce_0
coerce-key_0
line_0
col_0
pos_0
indentations_0
keep-comment?_0
parameter-override_0
parameter-cache_0
st_0)
(read-config/outer1.1
(read-config/inner2.1
readtable_0
next-readtable_0
for-syntax?_0
source_0
read-compiled_0
call-with-root-namespace_0
dynamic-require_0
module-declared?_0
coerce_0
coerce-key_0
parameter-override_0
parameter-cache_0
st_0)
wrap_0
line_0
col_0
pos_0
indentations_0
keep-comment?_0)))
(define read-config-wrap (lambda (v_0) (read-config/outer-wrap v_0)))
(define read-config-line (lambda (v_0) (read-config/outer-line v_0)))
(define read-config-col (lambda (v_0) (read-config/outer-col v_0)))
(define read-config-pos (lambda (v_0) (read-config/outer-pos v_0)))
(define read-config-indentations
(lambda (v_0) (read-config/outer-indentations v_0)))
(define read-config-keep-comment?
(lambda (v_0) (read-config/outer-keep-comment? v_0)))
(define read-config-readtable
(lambda (v_0) (read-config/inner-readtable (read-config/outer-inner v_0))))
(define read-config-next-readtable
(lambda (v_0)
(read-config/inner-next-readtable (read-config/outer-inner v_0))))
(define read-config-for-syntax?
(lambda (v_0) (read-config/inner-for-syntax? (read-config/outer-inner v_0))))
(define read-config-source
(lambda (v_0) (read-config/inner-source (read-config/outer-inner v_0))))
(define read-config-read-compiled
(lambda (v_0)
(read-config/inner-read-compiled (read-config/outer-inner v_0))))
(define read-config-call-with-root-namespace
(lambda (v_0)
(read-config/inner-call-with-root-namespace
(read-config/outer-inner v_0))))
(define read-config-dynamic-require
(lambda (v_0)
(read-config/inner-dynamic-require (read-config/outer-inner v_0))))
(define read-config-module-declared?
(lambda (v_0)
(read-config/inner-module-declared? (read-config/outer-inner v_0))))
(define read-config-coerce
(lambda (v_0) (read-config/inner-coerce (read-config/outer-inner v_0))))
(define read-config-coerce-key
(lambda (v_0) (read-config/inner-coerce-key (read-config/outer-inner v_0))))
(define read-config-parameter-override
(lambda (v_0)
(read-config/inner-parameter-override (read-config/outer-inner v_0))))
(define read-config-parameter-cache
(lambda (v_0)
(read-config/inner-parameter-cache (read-config/outer-inner v_0))))
(define read-config-st
(lambda (v_0) (read-config/inner-st (read-config/outer-inner v_0))))
(define struct:read-config-state
(make-record-type-descriptor*
'read-config-state
#f
(|#%nongenerative-uid| read-config-state)
#f
#f
2
3))
(define effect_2894
(struct-type-install-properties!
struct:read-config-state
'read-config-state
2
0
#f
null
(current-inspector)
#f
'()
#f
'read-config-state))
(define read-config-state3.1
(|#%name|
read-config-state
(record-constructor
(make-record-constructor-descriptor struct:read-config-state #f #f))))
(define read-config-state?_2637
(|#%name| read-config-state? (record-predicate struct:read-config-state)))
(define read-config-state?
(|#%name|
read-config-state?
(lambda (v)
(if (read-config-state?_2637 v)
#t
($value
(if (impersonator? v)
(read-config-state?_2637 (impersonator-val v))
#f))))))
(define read-config-state-accum-str_2333
(|#%name|
read-config-state-accum-str
(record-accessor struct:read-config-state 0)))
(define read-config-state-accum-str
(|#%name|
read-config-state-accum-str
(lambda (s)
(if (read-config-state?_2637 s)
(read-config-state-accum-str_2333 s)
($value
(impersonate-ref
read-config-state-accum-str_2333
struct:read-config-state
0
s
'read-config-state
'accum-str))))))
(define read-config-state-graph_2751
(|#%name|
read-config-state-graph
(record-accessor struct:read-config-state 1)))
(define read-config-state-graph
(|#%name|
read-config-state-graph
(lambda (s)
(if (read-config-state?_2637 s)
(read-config-state-graph_2751 s)
($value
(impersonate-ref
read-config-state-graph_2751
struct:read-config-state
1
s
'read-config-state
'graph))))))
(define set-read-config-state-accum-str!_2145
(|#%name|
set-read-config-state-accum-str!
(record-mutator struct:read-config-state 0)))
(define set-read-config-state-accum-str!
(|#%name|
set-read-config-state-accum-str!
(lambda (s v)
(if (read-config-state?_2637 s)
(set-read-config-state-accum-str!_2145 s v)
($value
(impersonate-set!
set-read-config-state-accum-str!_2145
struct:read-config-state
0
0
s
v
'read-config-state
'accum-str))))))
(define set-read-config-state-graph!_3119
(|#%name|
set-read-config-state-graph!
(record-mutator struct:read-config-state 1)))
(define set-read-config-state-graph!
(|#%name|
set-read-config-state-graph!
(lambda (s v)
(if (read-config-state?_2637 s)
(set-read-config-state-graph!_3119 s v)
($value
(impersonate-set!
set-read-config-state-graph!_3119
struct:read-config-state
1
1
s
v
'read-config-state
'graph))))))
(define default-val.1 #f)
(define current-read-config
(lambda () (continuation-mark-set-first #f current-read-config #f root-tag)))
(define make-read-config.1
(|#%name|
make-read-config
(lambda (call-with-root-namespace10_0
coerce13_0
coerce-key14_0
dynamic-require11_0
for-syntax?5_0
keep-comment?15_0
module-declared?12_0
next-readtable7_0
read-compiled9_0
readtable6_0
source4_0
wrap8_0)
(begin
(let ((readtable_0
(if (eq? readtable6_0 unsafe-undefined)
(1/current-readtable)
readtable6_0)))
(let ((next-readtable_0
(if (eq? next-readtable7_0 unsafe-undefined)
readtable_0
next-readtable7_0)))
(let ((read-compiled_0
(if read-compiled9_0
read-compiled9_0
(lambda (in_0)
(error 'read "no `read-compiled` provided")))))
(let ((call-with-root-namespace_0
(if call-with-root-namespace10_0
call-with-root-namespace10_0
(lambda (thunk_0)
(error
'read
"no `call-with-root-namespace` provided")))))
(let ((dynamic-require_0
(if dynamic-require11_0
dynamic-require11_0
(lambda (mod-path_0 sym_0 failure-k_0)
(error 'read "no `dynamic-require` provided")))))
(let ((module-declared?_0
(if module-declared?12_0
module-declared?12_0
(lambda (mod-path_0)
(error 'read "no `module-declare?` provided")))))
(let ((coerce_0
(if coerce13_0
coerce13_0
(lambda (for-syntax?_0 v_0 srcloc_0) v_0))))
(let ((coerce-key_0
(if coerce-key14_0
coerce-key14_0
(lambda (for-syntax?_0 v_0) v_0))))
(let ((parameter-override_0 hash2610))
(let ((parameter-cache_0 (make-hasheq)))
(let ((st_0 (read-config-state3.1 #f #f)))
(let ((parameter-cache_1 parameter-cache_0)
(parameter-override_1 parameter-override_0)
(coerce-key_1 coerce-key_0)
(coerce_1 coerce_0)
(module-declared?_1 module-declared?_0)
(dynamic-require_1 dynamic-require_0)
(call-with-root-namespace_1
call-with-root-namespace_0)
(read-compiled_1 read-compiled_0))
(begin-unsafe
(read-config/outer1.1
(read-config/inner2.1
readtable_0
next-readtable_0
for-syntax?5_0
source4_0
read-compiled_1
call-with-root-namespace_1
dynamic-require_1
module-declared?_1
coerce_1
coerce-key_1
parameter-override_1
parameter-cache_1
st_0)
wrap8_0
#f
#f
#f
null
keep-comment?15_0))))))))))))))))))
(define read-config-update.1
(|#%name|
read-config-update
(lambda (for-syntax?29_0
keep-comment?34_0
next-readtable32_0
readtable31_0
reset-graph?33_0
wrap30_0
config41_0)
(begin
(let ((next-readtable_0
(if (eq? next-readtable32_0 unsafe-undefined)
(begin-unsafe
(read-config/inner-readtable
(read-config/outer-inner config41_0)))
next-readtable32_0)))
(if (read-config/outer? 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
(read-config-state3.1 #f #f)
(begin-unsafe
(read-config/inner-st
(read-config/outer-inner config41_0))))))
(let ((parameter-override58_0 hash2610))
(let ((parameter-cache59_0 (make-hasheq)))
(let ((parameter-override58_1
parameter-override58_0)
(st57_1 st57_0))
(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))))
(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?"
config41_0)))))))
(define port+config->srcloc.1
(|#%name|
port+config->srcloc
(lambda (end-pos43_0 in45_0 config46_0)
(begin
(let ((end-pos_0
(if end-pos43_0
end-pos43_0
(call-with-values
(lambda () (port-next-location in45_0))
(case-lambda
((end-line_0 end-col_0 end-pos_0) end-pos_0)
(args (raise-binding-result-arity-error 3 args)))))))
(let ((app_0
(let ((or-part_0
(begin-unsafe
(read-config/inner-source
(read-config/outer-inner config46_0)))))
(if or-part_0
or-part_0
(let ((or-part_1 (object-name in45_0)))
(if or-part_1 or-part_1 "UNKNOWN"))))))
(unsafe-make-srcloc
app_0
(begin-unsafe (read-config/outer-line config46_0))
(begin-unsafe (read-config/outer-col config46_0))
(begin-unsafe (read-config/outer-pos config46_0))
(if (begin-unsafe (read-config/outer-pos config46_0))
(if end-pos_0
(max
0
(-
end-pos_0
(begin-unsafe (read-config/outer-pos config46_0))))
#f)
#f))))))))
(define reading-at
(lambda (config_0 line_0 col_0 pos_0)
(if (read-config/outer? config_0)
(let ((inner63_0 (read-config/outer-inner 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)))
(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)))
(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)
(if (not (begin-unsafe (read-config/outer-keep-comment? config_0)))
config_0
(if (read-config/outer? config_0)
(let ((inner69_0 (read-config/outer-inner config_0)))
(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 (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 ((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)))))
(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))))
(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)
(let ((for-syntax?_0
(begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config_0)))))
(|#%app|
(begin-unsafe
(read-config/inner-coerce (read-config/outer-inner config_0)))
for-syntax?_0
val_0
(if for-syntax?_0 (port+config->srcloc.1 #f in_0 config_0) #f)))))
(define default-reader-guard$1
(|#%name| default-reader-guard (lambda (v_0) (begin v_0))))
(define 1/current-reader-guard
(make-parameter
default-reader-guard$1
(lambda (v_0)
(begin
(if (if (procedure? v_0) (procedure-arity-includes? v_0 1) #f)
(void)
(raise-argument-error
'current-reader-guard
"(procedure-arity-includes/c 1)"
v_0))
v_0))
'current-reader-guard))
(define 1/read-square-bracket-as-paren
(make-parameter
#t
(lambda (v_0) (if v_0 #t #f))
'read-square-bracket-as-paren))
(define 1/read-curly-brace-as-paren
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-curly-brace-as-paren))
(define 1/read-square-bracket-with-tag
(make-parameter
#f
(lambda (v_0) (if v_0 #t #f))
'read-square-bracket-with-tag))
(define 1/read-curly-brace-with-tag
(make-parameter #f (lambda (v_0) (if v_0 #t #f)) 'read-curly-brace-with-tag))
(define 1/read-cdot
(make-parameter #f (lambda (v_0) (if v_0 #t #f)) 'read-cdot))
(define 1/read-accept-graph
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-accept-graph))
(define 1/read-accept-compiled
(make-parameter #f (lambda (v_0) (if v_0 #t #f)) 'read-accept-compiled))
(define 1/read-accept-box
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-accept-box))
(define 1/read-single-flonum
(make-parameter #f (lambda (v_0) (if v_0 #t #f)) 'read-single-flonum))
(define 1/read-decimal-as-inexact
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-decimal-as-inexact))
(define 1/read-accept-dot
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-accept-dot))
(define 1/read-accept-infix-dot
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-accept-infix-dot))
(define 1/read-accept-quasiquote
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-accept-quasiquote))
(define 1/read-accept-reader
(make-parameter #f (lambda (v_0) (if v_0 #t #f)) 'read-accept-reader))
(define 1/read-accept-lang
(make-parameter #t (lambda (v_0) (if v_0 #t #f)) 'read-accept-lang))
(define unknown (gensym 'unknown))
(define check-parameter
(lambda (param_0 config_0)
(let ((cache_0
(begin-unsafe
(read-config/inner-parameter-cache
(read-config/outer-inner config_0)))))
(let ((v_0
(hash-ref
(begin-unsafe
(read-config/inner-parameter-override
(read-config/outer-inner config_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 ((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
(begin-unsafe
(read-config/inner-parameter-override
(read-config/outer-inner config_0)))
param_0
v_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))))
(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)
(let ((cache_0
(begin-unsafe
(read-config/inner-parameter-cache
(read-config/outer-inner config_0)))))
(if (hash-ref cache_0 'all-forced #f)
(void)
(begin
(hash-set! cache_0 'all-forced #t)
(check-parameter read-case-sensitive config_0)
(check-parameter 1/read-square-bracket-as-paren config_0)
(check-parameter 1/read-curly-brace-as-paren config_0)
(check-parameter 1/read-square-bracket-with-tag config_0)
(check-parameter 1/read-curly-brace-with-tag config_0)
(check-parameter 1/read-cdot config_0)
(check-parameter 1/read-accept-graph config_0)
(check-parameter 1/read-accept-compiled config_0)
(check-parameter 1/read-accept-box config_0)
(check-parameter read-accept-bar-quote config_0)
(check-parameter 1/read-decimal-as-inexact config_0)
(check-parameter 1/read-single-flonum config_0)
(check-parameter 1/read-accept-dot config_0)
(check-parameter 1/read-accept-infix-dot config_0)
(check-parameter 1/read-accept-quasiquote config_0)
(check-parameter 1/read-accept-reader config_0)
(check-parameter 1/read-accept-lang config_0))))))
(define struct:special-comment
(make-record-type-descriptor*
'special-comment
#f
(|#%nongenerative-uid| special-comment)
#f
#f
1
0))
(define effect_2850
(struct-type-install-properties!
struct:special-comment
'special-comment
1
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0)
#f
'make-special-comment))
(define 1/make-special-comment
(|#%name|
make-special-comment
(record-constructor
(make-record-constructor-descriptor struct:special-comment #f #f))))
(define 1/special-comment?
(|#%name| special-comment? (record-predicate struct:special-comment)))
(define 1/special-comment-value
(|#%name| special-comment-value (record-accessor struct:special-comment 0)))
(define struct:readtable
(make-record-type-descriptor*
'readtable
#f
(|#%nongenerative-uid| readtable)
#f
#f
4
0))
(define effect_2799
(struct-type-install-properties!
struct:readtable
'readtable
4
0
#f
(list (cons prop:authentic #t) (cons prop:readtable #t))
(current-inspector)
#f
'(0 1 2 3)
#f
'readtable))
(define readtable1.1
(|#%name|
readtable
(record-constructor
(make-record-constructor-descriptor struct:readtable #f #f))))
(define 1/readtable? (|#%name| readtable? (record-predicate struct:readtable)))
(define readtable-symbol-parser
(|#%name| readtable-symbol-parser (record-accessor struct:readtable 0)))
(define readtable-char-ht
(|#%name| readtable-char-ht (record-accessor struct:readtable 1)))
(define readtable-dispatch-ht
(|#%name| readtable-dispatch-ht (record-accessor struct:readtable 2)))
(define readtable-delimiter-ht
(|#%name| readtable-delimiter-ht (record-accessor struct:readtable 3)))
(define 1/make-readtable
(|#%name|
make-readtable
(lambda (rt_0 . args_0)
(begin
(begin
(if (let ((or-part_0 (not rt_0)))
(if or-part_0 or-part_0 (1/readtable? rt_0)))
(void)
(raise-argument-error 'make-readtable "(or/c readtable? #f)" rt_0))
(letrec*
((loop_0
(|#%name|
loop
(lambda (args_1
symbol-parser_0
char-ht_0
dispatch-ht_0
delimiter-ht_0)
(begin
(if (null? args_1)
(readtable1.1
symbol-parser_0
char-ht_0
dispatch-ht_0
delimiter-ht_0)
(let ((key_0 (car args_1)))
(begin
(if (let ((or-part_0 (not key_0)))
(if or-part_0 or-part_0 (char? key_0)))
(void)
(raise-argument-error
'make-readtable
"(or/c char? #f)"
key_0))
(begin
(if (null? (cdr args_1))
(if key_0
(raise-arguments-error
'make-readtable
(string-append
"expected 'terminating-macro, 'non-terminating-macro, 'dispatch-macro,"
" or character argument after character argument")
"character"
key_0)
(raise-arguments-error
'make-readtable
"expected 'non-terminating-macro after #f"))
(void))
(let ((mode_0 (cadr args_1)))
(begin
(if key_0
(if (let ((or-part_0
(eq? mode_0 'terminating-macro)))
(if or-part_0
or-part_0
(let ((or-part_1
(eq?
mode_0
'non-terminating-macro)))
(if or-part_1
or-part_1
(let ((or-part_2
(eq?
mode_0
'dispatch-macro)))
(if or-part_2
or-part_2
(char? mode_0)))))))
(void)
(raise-argument-error
'make-readtable
"(or/c 'terminating-macro 'non-terminating-macro 'dispatch-macro char?)"
mode_0))
(if (eq? mode_0 'non-terminating-macro)
(void)
(raise-arguments-error
'make-readtable
"expected 'non-terminating-macro after #f")))
(begin
(if (null? (cddr args_1))
(raise-arguments-error
'make-readtable
(if key_0
"expected readtable or #f argument after character argument"
"expected procedure argument after symbol argument")
"given"
mode_0)
(void))
(let ((target_0 (caddr args_1)))
(let ((rest-args_0 (cdddr args_1)))
(if (not key_0)
(begin
(if (if (procedure? target_0)
(procedure-arity-includes?
target_0
6)
#f)
(void)
(raise-argument-error
'make-readtable
"(procedure-arity-includes/c 6)"
target_0))
(loop_0
rest-args_0
target_0
char-ht_0
dispatch-ht_0
delimiter-ht_0))
(if (eq? mode_0 'dispatch-macro)
(begin
(if (if (procedure? target_0)
(procedure-arity-includes?
target_0
6)
#f)
(void)
(raise-argument-error
'make-readtable
"(procedure-arity-includes/c 6)"
target_0))
(loop_0
rest-args_0
symbol-parser_0
char-ht_0
(hash-set
dispatch-ht_0
key_0
target_0)
delimiter-ht_0))
(if (char? mode_0)
(begin
(if (let ((or-part_0
(not target_0)))
(if or-part_0
or-part_0
(1/readtable? target_0)))
(void)
(raise-argument-error
'make-readtable
"(or/c readtable? #f)"
target_0))
(let ((actual-target_0
(let ((or-part_0
(if target_0
(hash-ref
(readtable-char-ht
target_0)
mode_0
#f)
#f)))
(if or-part_0
or-part_0
mode_0))))
(let ((new-char-ht_0
(if actual-target_0
(hash-set
char-ht_0
key_0
actual-target_0)
(hash-remove
char-ht_0
key_0))))
(let ((new-delimiter-ht_0
(hash-set
delimiter-ht_0
key_0
(if target_0
(hash-ref
(readtable-delimiter-ht
target_0)
mode_0
mode_0)
mode_0))))
(loop_0
rest-args_0
symbol-parser_0
new-char-ht_0
dispatch-ht_0
new-delimiter-ht_0)))))
(begin
(if (if (procedure? target_0)
(procedure-arity-includes?
target_0
6)
#f)
(void)
(raise-argument-error
'make-readtable
"(procedure-arity-includes/c 6)"
target_0))
(let ((new-char-ht_0
(hash-set
char-ht_0
key_0
target_0)))
(let ((new-delimiter-ht_0
(hash-set
delimiter-ht_0
key_0
(if (eq?
mode_0
'terminating-macro)
'delimit
'no-delimit))))
(loop_0
rest-args_0
symbol-parser_0
new-char-ht_0
dispatch-ht_0
new-delimiter-ht_0)))))))))))))))))))))
(let ((app_0 (if rt_0 (readtable-symbol-parser rt_0) #f)))
(let ((app_1 (if rt_0 (readtable-char-ht rt_0) hash2589)))
(let ((app_2 (if rt_0 (readtable-dispatch-ht rt_0) hash2589)))
(loop_0
args_0
app_0
app_1
app_2
(if rt_0 (readtable-delimiter-ht rt_0) hash2589)))))))))))
(define *readtable-effective-char
(lambda (rt_0 c_0)
(let ((target_0 (hash-ref (readtable-char-ht rt_0) c_0 #f)))
(if (not target_0) c_0 (if (char? target_0) target_0 '#\x78)))))
(define |readtable-effective-char/#|
(lambda (rt_0 c_0)
(if (if rt_0 (hash-ref (readtable-dispatch-ht rt_0) c_0 #f) #f) #f c_0)))
(define effective-char
(lambda (c_0 config_0)
(let ((rt_0
(begin-unsafe
(read-config/inner-readtable (read-config/outer-inner config_0)))))
(if (let ((or-part_0 (not rt_0)))
(if or-part_0 or-part_0 (not (char? c_0))))
c_0
(*readtable-effective-char rt_0 c_0)))))
(define readtable-handler
(lambda (config_0 c_0)
(let ((rt_0
(begin-unsafe
(read-config/inner-readtable (read-config/outer-inner config_0)))))
(if rt_0
(let ((target_0 (hash-ref (readtable-char-ht rt_0) c_0 #f)))
(if target_0 (if (not (char? target_0)) target_0 #f) #f))
#f))))
(define readtable-dispatch-handler
(lambda (config_0 c_0)
(begin
(force-parameters! config_0)
(let ((rt_0
(begin-unsafe
(read-config/inner-readtable
(read-config/outer-inner config_0)))))
(if rt_0 (hash-ref (readtable-dispatch-ht rt_0) c_0 #f) #f)))))
(define readtable-apply
(lambda (handler_0 c_0 in_0 config_0 line_0 col_0 pos_0)
(let ((for-syntax?_0
(begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config_0)))))
(let ((v_0
(if (not for-syntax?_0)
(with-continuation-mark*
push-authentic
current-read-config
config_0
(if (procedure-arity-includes? handler_0 2)
(|#%app| handler_0 c_0 in_0)
(|#%app| handler_0 c_0 in_0 #f line_0 col_0 pos_0)))
(with-continuation-mark*
push-authentic
current-read-config
config_0
(|#%app|
handler_0
c_0
in_0
(begin-unsafe
(read-config/inner-source
(read-config/outer-inner config_0)))
line_0
col_0
pos_0)))))
(if (1/special-comment? v_0) v_0 (coerce v_0 in_0 config_0))))))
(define 1/readtable-mapping
(|#%name|
readtable-mapping
(lambda (rt_0 c_0)
(begin
(begin
(if (1/readtable? rt_0)
(void)
(raise-argument-error 'readtable-mapping "readtable?" rt_0))
(begin
(if (char? c_0)
(void)
(raise-argument-error 'readtable-mapping "char?" c_0))
(let ((handler_0 (hash-ref (readtable-char-ht rt_0) c_0 #f)))
(let ((app_0
(let ((or-part_0
(if handler_0
(if (char? handler_0)
handler_0
(if (eq?
'delimit
(hash-ref
(readtable-delimiter-ht rt_0)
c_0
#f))
'terminating-macro
'non-terminating-macro))
#f)))
(if or-part_0 or-part_0 c_0))))
(let ((app_1 (if (char? handler_0) #f handler_0)))
(values
app_0
app_1
(hash-ref (readtable-dispatch-ht rt_0) c_0 #f)))))))))))
(define readtable-equivalent-chars
(lambda (rt_0 c_0)
(let ((ht_0 (readtable-char-ht rt_0)))
(let ((app_0 (if (hash-ref ht_0 c_0 #f) null (list c_0))))
(append
app_0
(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 ht_0 i_0))
(case-lambda
((k_0 v_0)
(let ((fold-var_1
(if (eqv? v_0 c_0)
(let ((fold-var_1 (cons k_0 fold-var_0)))
(values fold-var_1))
fold-var_0)))
(for-loop_0
fold-var_1
(hash-iterate-next ht_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
fold-var_0))))))
(for-loop_0 null (hash-iterate-first ht_0))))))))))
(define struct:special
(make-record-type-descriptor*
'special
#f
(|#%nongenerative-uid| special)
#f
#f
1
0))
(define effect_2658
(struct-type-install-properties!
struct:special
'special
1
0
#f
null
(current-inspector)
#f
'(0)
#f
'special))
(define special1.1
(|#%name|
special
(record-constructor
(make-record-constructor-descriptor struct:special #f #f))))
(define special?_3109 (|#%name| special? (record-predicate struct:special)))
(define special?
(|#%name|
special?
(lambda (v)
(if (special?_3109 v)
#t
($value
(if (impersonator? v) (special?_3109 (impersonator-val v)) #f))))))
(define special-value_2789
(|#%name| special-value (record-accessor struct:special 0)))
(define special-value
(|#%name|
special-value
(lambda (s)
(if (special?_3109 s)
(special-value_2789 s)
($value
(impersonate-ref
special-value_2789
struct:special
0
s
'special
'value))))))
(define wrap
(lambda (s-exp_0 in_0 config_0 rep_0)
(let ((wrap_0 (begin-unsafe (read-config/outer-wrap config_0))))
(if wrap_0
(|#%app| wrap_0 s-exp_0 (port+config->srcloc.1 #f in_0 config_0) rep_0)
s-exp_0))))
(define consume-char (lambda (in_0 c_0) (begin (read-char in_0) (void))))
(define consume-char/special
(lambda (in_0 config_0 c_0)
(begin
(read-char-or-special
in_0
special1.1
(begin-unsafe
(read-config/inner-source (read-config/outer-inner config_0))))
(void))))
(define reader-error.1
(|#%name|
reader-error
(lambda (continuation-marks1_0
due-to2_0
end-pos4_0
who3_0
in9_0
config10_0
str11_0
new-rest_0)
(begin
(let ((continuation-marks_0
(if (eq? continuation-marks1_0 unsafe-undefined)
(current-continuation-marks)
continuation-marks1_0)))
(let ((who_0
(if (eq? who3_0 unsafe-undefined)
(if (begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config10_0)))
'read-syntax
'read)
who3_0)))
(let ((msg_0
(format "~a: ~a" who_0 (apply format str11_0 new-rest_0))))
(let ((srcloc_0
(if in9_0
(port+config->srcloc.1 end-pos4_0 in9_0 config10_0)
#f)))
(raise
(let ((app_0
(if (eof-object? due-to2_0)
exn:fail:read:eof
(if (not (char? due-to2_0))
exn:fail:read:non-char
exn:fail:read))))
(let ((app_1
(let ((s_0
(if (error-print-source-location)
(if srcloc_0 (srcloc->string srcloc_0) #f)
#f)))
(if s_0 (string-append s_0 ": " msg_0) msg_0))))
(|#%app|
app_0
app_1
continuation-marks_0
(if srcloc_0 (list srcloc_0) null)))))))))))))
(define bad-syntax-error.1
(|#%name|
bad-syntax-error
(lambda (due-to13_0 in15_0 config16_0 str17_0)
(begin
(let ((temp25_0 "bad syntax `~a`"))
(reader-error.1
unsafe-undefined
due-to13_0
#f
unsafe-undefined
in15_0
config16_0
temp25_0
(list str17_0)))))))
(define catch-and-reraise-as-reader/proc
(lambda (in_0 config_0 thunk_0)
(let ((with-handlers-handler28_0
(|#%name|
with-handlers-handler28
(lambda (exn_0)
(begin
(let ((temp31_0 "~a"))
(let ((temp32_0
(let ((s_0 (exn-message exn_0)))
(regexp-replace "^[a-z-]*: " s_0 ""))))
(let ((temp33_0 (exn-continuation-marks exn_0)))
(let ((temp32_1 temp32_0) (temp31_1 temp31_0))
(reader-error.1
temp33_0
'#\x78
#f
unsafe-undefined
in_0
config_0
temp31_1
(list temp32_1)))))))))))
(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-handler28_0))))
(lambda () (|#%app| thunk_0)))))))
(define port-next-location*
(lambda (in_0 init-c_0)
(if (not init-c_0)
(port-next-location in_0)
(call-with-values
(lambda () (port-next-location in_0))
(case-lambda
((line_0 col_0 pos_0)
(let ((app_0 (if col_0 (max 0 (sub1 col_0)) #f)))
(values line_0 app_0 (if pos_0 (max 1 (sub1 pos_0)) #f))))
(args (raise-binding-result-arity-error 3 args)))))))
(define read-char/skip-whitespace-and-comments
(lambda (init-c_0 read-one_0 in_0 config_0)
(let ((rt_0
(begin-unsafe
(read-config/inner-readtable (read-config/outer-inner config_0)))))
(let ((source_0
(begin-unsafe
(read-config/inner-source (read-config/outer-inner config_0)))))
(letrec*
((skip-loop_0
(|#%name|
skip-loop
(lambda (init-c_1)
(begin
(let ((c_0
(if init-c_1
init-c_1
(read-char-or-special in_0 special1.1 source_0))))
(let ((ec_0
(if (let ((or-part_0 (not rt_0)))
(if or-part_0 or-part_0 (not (char? c_0))))
c_0
(*readtable-effective-char rt_0 c_0))))
(if (eof-object? ec_0)
c_0
(if (not (char? ec_0))
(let ((v_0 (special-value c_0)))
(if (if (1/special-comment? v_0)
(not
(begin-unsafe
(read-config/outer-keep-comment? config_0)))
#f)
(skip-loop_0 #f)
c_0))
(if (let ((or-part_0 (char-whitespace? ec_0)))
(if or-part_0 or-part_0 (eqv? '#\xfeff ec_0)))
(skip-loop_0 #f)
(if (char=? '#\x3b ec_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((c_1
(read-char-or-special
in_0
special1.1
source_0)))
(if (let ((or-part_0
(eof-object? c_1)))
(if or-part_0
or-part_0
(eqv?
'#\xa
(effective-char
c_1
config_0))))
(void)
(loop_0))))))))
(loop_0))
(if (begin-unsafe
(read-config/outer-keep-comment? config_0))
(result-special-comment)
(skip-loop_0 #f)))
(if (if (char=? '#\x23 ec_0)
(eqv?
'#\x7c
(|readtable-effective-char/#|
rt_0
(let ((c_1
(peek-char-or-special
in_0
0
'special
source_0)))
(if (eq? c_1 'special)
(special1.1 'special)
c_1))))
#f)
(begin
(skip-pipe-comment! c_0 in_0 config_0)
(if (begin-unsafe
(read-config/outer-keep-comment?
config_0))
(result-special-comment)
(skip-loop_0 #f)))
(if (if (char=? '#\x23 ec_0)
(if (eqv?
'#\x21
(|readtable-effective-char/#|
rt_0
(let ((c_1
(peek-char-or-special
in_0
0
'special
source_0)))
(if (eq? c_1 'special)
(special1.1 'special)
c_1))))
(let ((c3_0
(let ((c_1
(peek-char-or-special
in_0
1
'special
source_0)))
(if (eq? c_1 'special)
(special1.1 'special)
c_1))))
(let ((or-part_0 (eqv? '#\x20 c3_0)))
(if or-part_0
or-part_0
(eqv? '#\x2f c3_0))))
#f)
#f)
(begin
(skip-unix-line-comment! in_0 config_0)
(if (begin-unsafe
(read-config/outer-keep-comment?
config_0))
(result-special-comment)
(skip-loop_0 #f)))
(if (if (char=? '#\x23 ec_0)
(eqv?
'#\x3b
(|readtable-effective-char/#|
rt_0
(let ((c_1
(peek-char-or-special
in_0
0
'special
source_0)))
(if (eq? c_1 'special)
(special1.1 'special)
c_1))))
#f)
(begin
(begin-unsafe
(begin (read-char in_0) (void)))
(let ((v_0
(|#%app|
read-one_0
#f
in_0
config_0)))
(begin
(if (eof-object? v_0)
(let ((temp4_0
"expected a commented-out element for `~a;`, but found end-of-file"))
(reader-error.1
unsafe-undefined
v_0
#f
unsafe-undefined
in_0
config_0
temp4_0
(list ec_0)))
(void))
(if (begin-unsafe
(read-config/outer-keep-comment?
config_0))
(result-special-comment)
(skip-loop_0 #f)))))
c_0))))))))))))))
(skip-loop_0 init-c_0))))))
(define result-special-comment
(lambda () (special1.1 (1/make-special-comment #f))))
(define skip-pipe-comment!
(lambda (init-c_0 in_0 config_0)
(let ((source_0
(begin-unsafe
(read-config/inner-source (read-config/outer-inner config_0)))))
(call-with-values
(lambda () (port-next-location in_0))
(case-lambda
((line_0 col_0 pos_0)
(begin
(begin-unsafe (begin (read-char in_0) (void)))
(letrec*
((loop_0
(|#%name|
loop
(lambda (prev-c_0 depth_0)
(begin
(let ((c_0 (read-char-or-special in_0 special1.1 source_0)))
(if (eof-object? c_0)
(let ((temp7_0
(reading-at config_0 line_0 col_0 pos_0)))
(let ((temp9_0 "end of file in `#|` comment"))
(let ((temp7_1 temp7_0))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in_0
temp7_1
temp9_0
(list)))))
(if (not (char? c_0))
(loop_0 #f depth_0)
(if (if (char=? '#\x7c c_0) (eqv? prev-c_0 '#\x23) #f)
(loop_0 #f (add1 depth_0))
(if (if (char=? '#\x23 c_0)
(eqv? prev-c_0 '#\x7c)
#f)
(if (positive? depth_0)
(loop_0 #f (sub1 depth_0))
(void))
(loop_0 c_0 depth_0)))))))))))
(loop_0 #f 0))))
(args (raise-binding-result-arity-error 3 args)))))))
(define skip-unix-line-comment!
(lambda (in_0 config_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (backslash?_0)
(begin
(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)
(let ((dc_0
(let ((or-part_0
(if rt_0
(hash-ref (readtable-delimiter-ht rt_0) c_0 #f)
#f)))
(if or-part_0 or-part_0 c_0))))
(if (eq? dc_0 'no-delimit)
#f
(if (not (char? dc_0))
#t
(let ((or-part_0 (char-whitespace? dc_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (char=? dc_0 '#\x28)))
(if or-part_1
or-part_1
(let ((or-part_2 (char=? dc_0 '#\x29)))
(if or-part_2
or-part_2
(let ((or-part_3 (char=? dc_0 '#\x5b)))
(if or-part_3
or-part_3
(let ((or-part_4 (char=? dc_0 '#\x5d)))
(if or-part_4
or-part_4
(let ((or-part_5 (char=? dc_0 '#\x7b)))
(if or-part_5
or-part_5
(let ((or-part_6 (char=? dc_0 '#\x7d)))
(if or-part_6
or-part_6
(let ((or-part_7 (char=? dc_0 '#\x27)))
(if or-part_7
or-part_7
(let ((or-part_8
(char=? dc_0 '#\x60)))
(if or-part_8
or-part_8
(let ((or-part_9
(char=? dc_0 '#\x2c)))
(if or-part_9
or-part_9
(let ((or-part_10
(char=? dc_0 '#\x3b)))
(if or-part_10
or-part_10
(let ((or-part_11
(char=?
dc_0
'#\x22)))
(if or-part_11
or-part_11
(let ((or-part_12
(char=?
dc_0
'#\xfeff)))
(if or-part_12
or-part_12
(if (char=?
dc_0
'#\x2e)
(check-parameter
1/read-cdot
config_0)
#f))))))))))))))))))))))))))))))))
(define char-delimiter?
(lambda (c_0 config_0)
(readtable-char-delimiter?
(begin-unsafe
(read-config/inner-readtable (read-config/outer-inner config_0)))
c_0
config_0)))
(define char-closer?
(lambda (ec_0 config_0)
(if (not (eof-object? ec_0))
(let ((or-part_0 (char=? ec_0 '#\x29)))
(if or-part_0
or-part_0
(let ((or-part_1 (char=? ec_0 '#\x5d)))
(if or-part_1 or-part_1 (char=? ec_0 '#\x7d)))))
#f)))
(define closer-name
(lambda (c_0 config_0) (effective-char-names c_0 config_0 "closer")))
(define opener-name
(lambda (c_0 config_0) (effective-char-names c_0 config_0 "opener")))
(define effective-char-names
(lambda (c_0 config_0 fallback-str_0)
(let ((rt_0
(begin-unsafe
(read-config/inner-readtable (read-config/outer-inner config_0)))))
(if (not rt_0)
(format "`~a`" c_0)
(let ((cs_0 (readtable-equivalent-chars rt_0 c_0)))
(if (null? cs_0)
fallback-str_0
(if (null? (cdr cs_0))
(format "`~a`" (car cs_0))
(if (null? (cddr cs_0))
(let ((app_0 (car cs_0)))
(format "`~a` or `~a`" app_0 (cadr cs_0)))
(apply
string-append
(letrec*
((loop_0
(|#%name|
loop
(lambda (cs_1)
(begin
(if (null? (cdr cs_1))
(list (format "or `~a`" (car cs_1)))
(let ((app_0 (format "`~a`, " (car cs_1))))
(cons app_0 (loop_0 (cdr cs_1))))))))))
(loop_0 cs_0)))))))))))
(define closer->opener
(lambda (c_0)
(if (eqv? c_0 '#\x29)
'#\x28
(if (eqv? c_0 '#\x5d) '#\x5b (if (eqv? c_0 '#\x7d) '#\x7b c_0)))))
(define dot-name (lambda (config_0) "`.`"))
(define all-openers-str
(lambda (config_0)
(let ((p_0 (begin-unsafe (effective-char-names '#\x28 config_0 "opener"))))
(let ((s_0
(if (check-parameter 1/read-square-bracket-as-paren config_0)
(begin-unsafe (effective-char-names '#\x5b config_0 "opener"))
#f)))
(let ((c_0
(if (check-parameter 1/read-curly-brace-as-paren config_0)
(begin-unsafe (effective-char-names '#\x7b config_0 "opener"))
#f)))
(if (if s_0 c_0 #f)
(format "~a, ~a, or ~a" p_0 s_0 c_0)
(if (if s_0 s_0 c_0)
(format "~a or ~a" p_0 (if s_0 s_0 c_0))
p_0)))))))
(define struct:accum-string
(make-record-type-descriptor*
'accum-string
#f
(|#%nongenerative-uid| accum-string)
#f
#f
2
3))
(define effect_2103
(struct-type-install-properties!
struct:accum-string
'accum-string
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'()
#f
'accum-string))
(define accum-string1.1
(|#%name|
accum-string
(record-constructor
(make-record-constructor-descriptor struct:accum-string #f #f))))
(define accum-string?
(|#%name| accum-string? (record-predicate struct:accum-string)))
(define accum-string-pos
(|#%name| accum-string-pos (record-accessor struct:accum-string 0)))
(define accum-string-str
(|#%name| accum-string-str (record-accessor struct:accum-string 1)))
(define set-accum-string-pos!
(|#%name| set-accum-string-pos! (record-mutator struct:accum-string 0)))
(define set-accum-string-str!
(|#%name| set-accum-string-str! (record-mutator struct:accum-string 1)))
(define accum-string-init!
(lambda (config_0)
(let ((st_0
(begin-unsafe
(read-config/inner-st (read-config/outer-inner config_0)))))
(let ((a_0 (read-config-state-accum-str st_0)))
(if a_0
(begin
(set-read-config-state-accum-str! st_0 #f)
(set-accum-string-pos! a_0 0)
a_0)
(accum-string1.1 0 (make-string 32)))))))
(define accum-string-add!
(lambda (a_0 c_0)
(let ((pos_0 (accum-string-pos a_0)))
(let ((str_0 (accum-string-str a_0)))
(let ((str2_0
(if (fx< pos_0 (string-length str_0))
str_0
(let ((str2_0 (make-string (fx* (string-length str_0) 2))))
(begin
(string-copy! str2_0 0 str_0)
(set-accum-string-str! a_0 str2_0)
str2_0)))))
(begin
(string-set! str2_0 pos_0 c_0)
(set-accum-string-pos! a_0 (fx+ 1 pos_0))))))))
(define accum-string-count (lambda (a_0) (accum-string-pos a_0)))
(define set-accum-string-count!
(lambda (a_0 pos_0) (set-accum-string-pos! a_0 pos_0)))
(define accum-string-convert!
(lambda (a_0 convert_0 start-pos_0)
(let ((str_0 (accum-string-str a_0)))
(let ((s_0
(|#%app|
convert_0
(substring str_0 start-pos_0 (accum-string-pos a_0)))))
(let ((len_0 (string-length s_0)))
(begin
(if (let ((app_0 (fx+ len_0 start-pos_0)))
(fx< app_0 (string-length str_0)))
(void)
(let ((str2_0 (make-string (fx+ start-pos_0 len_0))))
(begin
(string-copy! str2_0 0 str_0 0 start-pos_0)
(set-accum-string-str! a_0 str2_0))))
(string-copy! (accum-string-str a_0) start-pos_0 s_0)
(set-accum-string-pos! a_0 (fx+ start-pos_0 len_0))))))))
(define accum-string-get!.1
(|#%name|
accum-string-get!
(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)))))
(begin
(begin-unsafe
(set-read-config-state-accum-str!
(begin-unsafe
(read-config/inner-st (read-config/outer-inner config5_0)))
a4_0))
s_0))))))
(define accum-string-get-bytes!.1
(|#%name|
accum-string-get-bytes!
(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)))))
(begin
(begin-unsafe
(set-read-config-state-accum-str!
(begin-unsafe
(read-config/inner-st (read-config/outer-inner config10_0)))
a9_0))
bstr_0))))))
(define accum-string-abandon!
(lambda (a_0 config_0)
(set-read-config-state-accum-str!
(begin-unsafe (read-config/inner-st (read-config/outer-inner config_0)))
a_0)))
(define struct:indentation
(make-record-type-descriptor*
'indentation
#f
(|#%nongenerative-uid| indentation)
#f
#f
8
246))
(define effect_2519
(struct-type-install-properties!
struct:indentation
'indentation
8
0
#f
null
(current-inspector)
#f
'(0 3)
#f
'indentation))
(define indentation1.1
(|#%name|
indentation
(record-constructor
(make-record-constructor-descriptor struct:indentation #f #f))))
(define indentation?_2766
(|#%name| indentation? (record-predicate struct:indentation)))
(define indentation?
(|#%name|
indentation?
(lambda (v)
(if (indentation?_2766 v)
#t
($value
(if (impersonator? v) (indentation?_2766 (impersonator-val v)) #f))))))
(define indentation-closer_2003
(|#%name| indentation-closer (record-accessor struct:indentation 0)))
(define indentation-closer
(|#%name|
indentation-closer
(lambda (s)
(if (indentation?_2766 s)
(indentation-closer_2003 s)
($value
(impersonate-ref
indentation-closer_2003
struct:indentation
0
s
'indentation
'closer))))))
(define indentation-suspicious-closer_2131
(|#%name|
indentation-suspicious-closer
(record-accessor struct:indentation 1)))
(define indentation-suspicious-closer
(|#%name|
indentation-suspicious-closer
(lambda (s)
(if (indentation?_2766 s)
(indentation-suspicious-closer_2131 s)
($value
(impersonate-ref
indentation-suspicious-closer_2131
struct:indentation
1
s
'indentation
'suspicious-closer))))))
(define indentation-multiline?_2443
(|#%name| indentation-multiline? (record-accessor struct:indentation 2)))
(define indentation-multiline?
(|#%name|
indentation-multiline?
(lambda (s)
(if (indentation?_2766 s)
(indentation-multiline?_2443 s)
($value
(impersonate-ref
indentation-multiline?_2443
struct:indentation
2
s
'indentation
'multiline?))))))
(define indentation-start-line_2628
(|#%name| indentation-start-line (record-accessor struct:indentation 3)))
(define indentation-start-line
(|#%name|
indentation-start-line
(lambda (s)
(if (indentation?_2766 s)
(indentation-start-line_2628 s)
($value
(impersonate-ref
indentation-start-line_2628
struct:indentation
3
s
'indentation
'start-line))))))
(define indentation-last-line_2502
(|#%name| indentation-last-line (record-accessor struct:indentation 4)))
(define indentation-last-line
(|#%name|
indentation-last-line
(lambda (s)
(if (indentation?_2766 s)
(indentation-last-line_2502 s)
($value
(impersonate-ref
indentation-last-line_2502
struct:indentation
4
s
'indentation
'last-line))))))
(define indentation-suspicious-line_2778
(|#%name|
indentation-suspicious-line
(record-accessor struct:indentation 5)))
(define indentation-suspicious-line
(|#%name|
indentation-suspicious-line
(lambda (s)
(if (indentation?_2766 s)
(indentation-suspicious-line_2778 s)
($value
(impersonate-ref
indentation-suspicious-line_2778
struct:indentation
5
s
'indentation
'suspicious-line))))))
(define indentation-max-indent_2482
(|#%name| indentation-max-indent (record-accessor struct:indentation 6)))
(define indentation-max-indent
(|#%name|
indentation-max-indent
(lambda (s)
(if (indentation?_2766 s)
(indentation-max-indent_2482 s)
($value
(impersonate-ref
indentation-max-indent_2482
struct:indentation
6
s
'indentation
'max-indent))))))
(define indentation-suspicious-quote_2590
(|#%name|
indentation-suspicious-quote
(record-accessor struct:indentation 7)))
(define indentation-suspicious-quote
(|#%name|
indentation-suspicious-quote
(lambda (s)
(if (indentation?_2766 s)
(indentation-suspicious-quote_2590 s)
($value
(impersonate-ref
indentation-suspicious-quote_2590
struct:indentation
7
s
'indentation
'suspicious-quote))))))
(define set-indentation-suspicious-closer!_2590
(|#%name|
set-indentation-suspicious-closer!
(record-mutator struct:indentation 1)))
(define set-indentation-suspicious-closer!
(|#%name|
set-indentation-suspicious-closer!
(lambda (s v)
(if (indentation?_2766 s)
(set-indentation-suspicious-closer!_2590 s v)
($value
(impersonate-set!
set-indentation-suspicious-closer!_2590
struct:indentation
1
1
s
v
'indentation
'suspicious-closer))))))
(define set-indentation-multiline?!_2223
(|#%name| set-indentation-multiline?! (record-mutator struct:indentation 2)))
(define set-indentation-multiline?!
(|#%name|
set-indentation-multiline?!
(lambda (s v)
(if (indentation?_2766 s)
(set-indentation-multiline?!_2223 s v)
($value
(impersonate-set!
set-indentation-multiline?!_2223
struct:indentation
2
2
s
v
'indentation
'multiline?))))))
(define set-indentation-last-line!_2595
(|#%name| set-indentation-last-line! (record-mutator struct:indentation 4)))
(define set-indentation-last-line!
(|#%name|
set-indentation-last-line!
(lambda (s v)
(if (indentation?_2766 s)
(set-indentation-last-line!_2595 s v)
($value
(impersonate-set!
set-indentation-last-line!_2595
struct:indentation
4
4
s
v
'indentation
'last-line))))))
(define set-indentation-suspicious-line!_2285
(|#%name|
set-indentation-suspicious-line!
(record-mutator struct:indentation 5)))
(define set-indentation-suspicious-line!
(|#%name|
set-indentation-suspicious-line!
(lambda (s v)
(if (indentation?_2766 s)
(set-indentation-suspicious-line!_2285 s v)
($value
(impersonate-set!
set-indentation-suspicious-line!_2285
struct:indentation
5
5
s
v
'indentation
'suspicious-line))))))
(define set-indentation-max-indent!_2868
(|#%name| set-indentation-max-indent! (record-mutator struct:indentation 6)))
(define set-indentation-max-indent!
(|#%name|
set-indentation-max-indent!
(lambda (s v)
(if (indentation?_2766 s)
(set-indentation-max-indent!_2868 s v)
($value
(impersonate-set!
set-indentation-max-indent!_2868
struct:indentation
6
6
s
v
'indentation
'max-indent))))))
(define set-indentation-suspicious-quote!_2621
(|#%name|
set-indentation-suspicious-quote!
(record-mutator struct:indentation 7)))
(define set-indentation-suspicious-quote!
(|#%name|
set-indentation-suspicious-quote!
(lambda (s v)
(if (indentation?_2766 s)
(set-indentation-suspicious-quote!_2621 s v)
($value
(impersonate-set!
set-indentation-suspicious-quote!_2621
struct:indentation
7
7
s
v
'indentation
'suspicious-quote))))))
(define make-indentation
(lambda (closer_0 in_0 config_0)
(call-with-values
(lambda () (port-next-location in_0))
(case-lambda
((line_0 col_0 pos_0)
(indentation1.1
closer_0
#f
#f
line_0
line_0
#f
(if col_0 (add1 col_0) #f)
#f))
(args (raise-binding-result-arity-error 3 args))))))
(define track-indentation!
(lambda (config_0 line_0 col_0)
(let ((indts_0 (begin-unsafe (read-config/outer-indentations config_0))))
(let ((indt_0 (if (pair? indts_0) (car indts_0) #f)))
(if (if indt_0
(if line_0
(if (indentation-last-line indt_0)
(> line_0 (indentation-last-line indt_0))
#f)
#f)
#f)
(begin
(set-indentation-last-line! indt_0 line_0)
(set-indentation-multiline?! indt_0 #t)
(if (>= col_0 (indentation-max-indent indt_0))
(set-indentation-max-indent! indt_0 col_0)
(if (indentation-suspicious-line indt_0)
(void)
(begin
(set-indentation-suspicious-closer!
indt_0
(indentation-closer indt_0))
(set-indentation-suspicious-line! indt_0 line_0)))))
(void))))))
(define indentation-possible-cause
(lambda (config_0)
(let ((indt_0
(car (begin-unsafe (read-config/outer-indentations config_0)))))
(if (indentation-suspicious-line indt_0)
(let ((app_0
(let ((c_0 (indentation-suspicious-closer indt_0)))
(begin-unsafe (effective-char-names c_0 config_0 "closer")))))
(format
"\n possible cause: indentation suggests a missing ~a before line ~a"
app_0
(indentation-suspicious-line indt_0)))
""))))
(define indentation-unexpected-closer-message
(lambda (ec_0 c_0 config_0)
(let ((indts_0 (begin-unsafe (read-config/outer-indentations config_0))))
(if (null? indts_0)
(format "unexpected `~a`" c_0)
(let ((indt_0 (car indts_0)))
(let ((app_0
(if (char=? ec_0 (indentation-closer indt_0))
(format "unexpected `~a`" c_0)
(let ((missing_0
(let ((or-part_0
(let ((lst_0 (cdr indts_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((indt_1
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(let ((result_1
(let ((result_1
(if (char=?
ec_0
(indentation-closer
indt_1))
"missing"
#f)))
(values
result_1))))
(if (if (not
(let ((x_0
(list
indt_1)))
result_1))
#t
#f)
(for-loop_0
result_1
rest_0)
result_1))))
result_0))))))
(for-loop_0 #f lst_0))))))
(if or-part_0 or-part_0 "expected"))))
(let ((opener-str_0
(let ((c_1
(closer->opener
(indentation-closer indt_0))))
(begin-unsafe
(effective-char-names c_1 config_0 "opener")))))
(let ((app_0
(let ((c_1 (indentation-closer indt_0)))
(begin-unsafe
(effective-char-names
c_1
config_0
"closer")))))
(format
"~a ~a to close ~a, found instead `~a`"
missing_0
app_0
(if (indentation-multiline? indt_0)
(format
"~a on line ~a"
opener-str_0
(indentation-start-line indt_0))
(format "preceding ~a" opener-str_0))
c_0)))))))
(string-append app_0 (indentation-possible-cause config_0))))))))
(define read-unwrapped-sequence.1
(|#%name|
read-unwrapped-sequence
(lambda (dot-mode2_0
elem-config1_0
first-read-one5_0
shape-tag?3_0
whitespace-read-one4_0
read-one11_0
opener-c12_0
opener13_0
closer14_0
in15_0
seq-config16_0)
(begin
(let ((elem-config_0
(if (eq? elem-config1_0 unsafe-undefined)
(next-readtable seq-config16_0)
elem-config1_0)))
(let ((whitespace-read-one_0
(if (eq? whitespace-read-one4_0 unsafe-undefined)
read-one11_0
whitespace-read-one4_0)))
(let ((first-read-one_0
(if (eq? first-read-one5_0 unsafe-undefined)
read-one11_0
first-read-one5_0)))
(let ((head_0 #f))
(let ((indentation_0
(make-indentation closer14_0 in15_0 seq-config16_0)))
(let ((config_0
(if (read-config/outer? elem-config_0)
(let ((indentations18_0
(cons
indentation_0
(begin-unsafe
(read-config/outer-indentations
seq-config16_0)))))
(let ((inner19_0
(read-config/outer-inner 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?"
elem-config_0))))
(call-with-values
(lambda () (port-next-location in15_0))
(case-lambda
((open-end-line_0 open-end-col_0 open-end-pos_0)
(let ((config/keep-comment_0 (keep-comment config_0)))
(let ((read-one/not-eof_0
(|#%name|
read-one/not-eof
(lambda (init-c_0 read-one_0 config_1)
(begin
(let ((e_0
(|#%app|
read-one_0
init-c_0
in15_0
config_1)))
(begin
(if (eof-object? e_0)
(let ((temp24_0
"expected a ~a to close `~a`~a"))
(let ((temp25_0
(begin-unsafe
(effective-char-names
closer14_0
config_1
"closer"))))
(let ((temp27_0
(indentation-possible-cause
config_1)))
(let ((temp25_1 temp25_0)
(temp24_1 temp24_0))
(reader-error.1
unsafe-undefined
e_0
open-end-pos_0
unsafe-undefined
in15_0
seq-config16_0
temp24_1
(list
temp25_1
opener-c12_0
temp27_0))))))
(void))
e_0)))))))
(let ((seq_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (depth_0
accum_0
init-c_0
first?_0
first-read-one_1)
(begin
(let ((c_0
(read-char/skip-whitespace-and-comments
init-c_0
whitespace-read-one_0
in15_0
seq-config16_0)))
(let ((ec_0
(effective-char
c_0
seq-config16_0)))
(if (eqv? ec_0 closer14_0)
(if (null? accum_0)
null
(reverse$1 accum_0))
(if (if (not first?_0)
(if (eqv? ec_0 '#\x2e)
(if (check-parameter
1/read-accept-dot
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
0
'special
source_0)))
(if (eq?
c_1
'special)
(special1.1
'special)
c_1))))
(begin-unsafe
(readtable-char-delimiter?
(begin-unsafe
(read-config/inner-readtable
(read-config/outer-inner
seq-config16_0)))
c_1
seq-config16_0))))
#f)
#f)
#f)
(call-with-values
(lambda ()
(port-next-location*
in15_0
c_0))
(case-lambda
((dot-line_0
dot-col_0
dot-pos_0)
(begin
(track-indentation!
config_0
dot-line_0
dot-col_0)
(begin
(if (if dot-mode2_0
(not head_0)
#f)
(void)
(let ((temp29_0
(reading-at
config_0
dot-line_0
dot-col_0
dot-pos_0)))
(let ((temp30_0
"illegal use of `.`"))
(let ((temp29_1
temp29_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in15_0
temp29_1
temp30_0
(list))))))
(let ((v_0
(read-one/not-eof_0
#f
first-read-one_1
config_0)))
(let ((rest-c_0
(read-char/skip-whitespace-and-comments
#f
whitespace-read-one_0
in15_0
seq-config16_0)))
(let ((rest-ec_0
(effective-char
rest-c_0
seq-config16_0)))
(if (eqv?
rest-ec_0
closer14_0)
(if (null?
accum_0)
v_0
(append
(reverse$1
accum_0)
v_0))
(if (if (eqv?
rest-ec_0
'#\x2e)
(if (check-parameter
1/read-accept-dot
config_0)
(if (check-parameter
1/read-accept-infix-dot
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
0
'special
source_0)))
(if (eq?
c_1
'special)
(special1.1
'special)
c_1))))
(begin-unsafe
(readtable-char-delimiter?
(begin-unsafe
(read-config/inner-readtable
(read-config/outer-inner
seq-config16_0)))
c_1
seq-config16_0))))
#f)
#f)
#f)
(begin
(set! head_0
(box
v_0))
(call-with-values
(lambda ()
(port-next-location
in15_0))
(case-lambda
((dot2-line_0
dot2-col_0
dot2-pos_0)
(begin
(track-indentation!
config_0
dot2-line_0
dot2-col_0)
(let ((post-c_0
(read-char/skip-whitespace-and-comments
#f
whitespace-read-one_0
in15_0
seq-config16_0)))
(let ((post-ec_0
(effective-char
post-c_0
seq-config16_0)))
(begin
(if (let ((or-part_0
(eof-object?
post-ec_0)))
(if or-part_0
or-part_0
(eqv?
post-ec_0
closer14_0)))
(let ((temp32_0
(reading-at
config_0
dot-line_0
dot-col_0
dot-pos_0)))
(let ((temp34_0
"illegal use of `.`"))
(let ((temp32_1
temp32_0))
(reader-error.1
unsafe-undefined
post-ec_0
#f
unsafe-undefined
in15_0
temp32_1
temp34_0
(list)))))
(void))
(loop_0
depth_0
accum_0
post-c_0
#f
read-one11_0))))))
(args
(raise-binding-result-arity-error
3
args)))))
(let ((temp36_0
(reading-at
config_0
dot-line_0
dot-col_0
dot-pos_0)))
(let ((temp38_0
"illegal use of `.`"))
(let ((temp36_1
temp36_0))
(reader-error.1
unsafe-undefined
rest-c_0
#f
unsafe-undefined
in15_0
temp36_1
temp38_0
(list)))))))))))))
(args
(raise-binding-result-arity-error
3
args))))
(let ((v_0
(read-one/not-eof_0
c_0
first-read-one_1
config/keep-comment_0)))
(if (1/special-comment? v_0)
(loop_0
depth_0
accum_0
#f
#f
read-one11_0)
(if (> depth_0 1024)
(loop_0
depth_0
(cons v_0 accum_0)
#f
#f
read-one11_0)
(cons
v_0
(loop_0
(add1 depth_0)
null
#f
#f
read-one11_0))))))))))))))
(loop_0 0 null #f #t first-read-one_0))))
(let ((full-seq_0
(if head_0
(cons (unbox head_0) seq_0)
seq_0)))
(if shape-tag?3_0
(add-shape-tag
opener13_0
in15_0
config_0
full-seq_0)
full-seq_0))))))
(args
(raise-binding-result-arity-error 3 args))))))))))))))
(define add-shape-tag
(lambda (opener_0 in_0 config_0 seq_0)
(let ((tag_0
(if (eqv? opener_0 '#\x5b)
(if (check-parameter 1/read-square-bracket-with-tag config_0)
'|#%brackets|
#f)
(if (eqv? opener_0 '#\x7b)
(if (check-parameter 1/read-curly-brace-with-tag config_0)
'|#%braces|
#f)
#f))))
(if tag_0 (cons (wrap tag_0 in_0 config_0 #f) seq_0) seq_0))))
(define not-an-fX.1$1
(|#%name|
not-an-fX
(lambda (who_0 v_0) (begin (raise-argument-error who_0 "flonum?" v_0)))))
(define read-digits.1
(|#%name|
read-digits
(lambda (base1_0
init3_0
max-count2_0
zero-digits-result4_0
in10_0
config11_0
accum-str9_0)
(begin
(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 ((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))
#f
(if (= base_0 8)
(octal-digit? c_0)
(if (= base_0 16) (hex-digit? c_0) (decimal-digit? c_0))))))
(define decimal-digit?
(lambda (c_0) (if (char>=? c_0 '#\x30) (char<=? c_0 '#\x39) #f)))
(define octal-digit?
(lambda (c_0) (if (char>=? c_0 '#\x30) (char<=? c_0 '#\x37) #f)))
(define hex-digit?
(lambda (c_0)
(let ((or-part_0 (if (char>=? c_0 '#\x30) (char<=? c_0 '#\x39) #f)))
(if or-part_0
or-part_0
(let ((or-part_1 (if (char>=? c_0 '#\x41) (char<=? c_0 '#\x46) #f)))
(if or-part_1
or-part_1
(if (char>=? c_0 '#\x61) (char<=? c_0 '#\x66) #f)))))))
(define digit->number
(lambda (c_0)
(if (if (char>=? c_0 '#\x30) (char<=? c_0 '#\x39) #f)
(- (char->integer c_0) 48)
(if (if (char>=? c_0 '#\x41) (char<=? c_0 '#\x46) #f)
(- (char->integer c_0) 55)
(- (char->integer c_0) 87)))))
(define maybe-digit
(lambda (c_0 radix_0)
(let ((v_0 (char->integer c_0)))
(if (fx< v_0 48)
c_0
(if (fx< v_0 (fx+ (fxmin radix_0 10) 48))
(fx- v_0 48)
(if (fx<= radix_0 10)
c_0
(if (fx< v_0 65)
c_0
(if (fx< v_0 (+ radix_0 55))
(fx- v_0 55)
(if (fx< v_0 97)
c_0
(if (fx< v_0 (+ radix_0 87)) (fx- v_0 87) c_0))))))))))
(define string->number$1 string->number)
(define 1/string->number
(let ((string->number_0
(|#%name|
string->number
(lambda (s5_0
radix1_0
convert-mode2_0
decimal-mode3_0
single-mode4_0)
(begin
(let ((decimal-mode_0
(if (eq? decimal-mode3_0 unsafe-undefined)
(if (1/read-decimal-as-inexact)
'decimal-as-inexact
'decimal-as-exact)
decimal-mode3_0)))
(let ((single-mode_0
(if (eq? single-mode4_0 unsafe-undefined)
(if (1/read-single-flonum) 'single 'double)
single-mode4_0)))
(begin
(if (string? s5_0)
(void)
(raise-argument-error 'string->number "string?" s5_0))
(if (if (exact-integer? radix1_0) (<= 2 radix1_0 16) #f)
(void)
(raise-argument-error
'string->number
"(integer-in 2 16)"
radix1_0))
(if (let ((or-part_0
(eq? convert-mode2_0 'number-or-false)))
(if or-part_0 or-part_0 (eq? convert-mode2_0 'read)))
(void)
(raise-argument-error
'string->number
"(or/c 'number-or-false 'read)"
convert-mode2_0))
(if (let ((or-part_0
(eq? decimal-mode_0 'decimal-as-inexact)))
(if or-part_0
or-part_0
(eq? decimal-mode_0 'decimal-as-exact)))
(void)
(raise-argument-error
'string->number
"(or/c 'decimal-as-inexact 'decimal-as-exact)"
decimal-mode_0))
(if (let ((or-part_0 (eq? single-mode_0 'single)))
(if or-part_0 or-part_0 (eq? single-mode_0 'double)))
(void)
(raise-argument-error
'string->number
"(or/c 'single 'double)"
single-mode_0))
(|#%app|
unchecked-string->number
s5_0
radix1_0
convert-mode2_0
decimal-mode_0
single-mode_0)))))))))
(|#%name|
string->number
(case-lambda
((s_0)
(begin
(string->number_0
s_0
10
'number-or-false
unsafe-undefined
unsafe-undefined)))
((s_0 radix_0 convert-mode_0 decimal-mode_0 single-mode4_0)
(string->number_0
s_0
radix_0
convert-mode_0
decimal-mode_0
single-mode4_0))
((s_0 radix_0 convert-mode_0 decimal-mode3_0)
(string->number_0
s_0
radix_0
convert-mode_0
decimal-mode3_0
unsafe-undefined))
((s_0 radix_0 convert-mode2_0)
(string->number_0
s_0
radix_0
convert-mode2_0
unsafe-undefined
unsafe-undefined))
((s_0 radix1_0)
(string->number_0
s_0
radix1_0
'number-or-false
unsafe-undefined
unsafe-undefined))))))
(define unchecked-string->number
(lambda (s_0 radix_0 convert-mode_0 decimal-mode_0 single-mode_0)
(let ((temp46_0 (string-length s_0)))
(|#%app|
do-string->number.1
#f
s_0
0
temp46_0
radix_0
decimal-mode_0
convert-mode_0
single-mode_0))))
(define struct:parse-state
(make-record-type-descriptor*
'parse-state
#f
(|#%nongenerative-uid| parse-state)
#f
#f
5
0))
(define effect_2060
(struct-type-install-properties!
struct:parse-state
'parse-state
5
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2 3 4)
#f
'parse-state))
(define parse-state6.1
(|#%name|
parse-state
(record-constructor
(make-record-constructor-descriptor struct:parse-state #f #f))))
(define parse-state?
(|#%name| parse-state? (record-predicate struct:parse-state)))
(define parse-state-exactness
(|#%name| parse-state-exactness (record-accessor struct:parse-state 0)))
(define parse-state-convert-mode
(|#%name| parse-state-convert-mode (record-accessor struct:parse-state 1)))
(define parse-state-can-single?
(|#%name| parse-state-can-single? (record-accessor struct:parse-state 2)))
(define parse-state-fst
(|#%name| parse-state-fst (record-accessor struct:parse-state 3)))
(define parse-state-other-exactness
(|#%name|
parse-state-other-exactness
(record-accessor struct:parse-state 4)))
(define struct:rect-prefix
(make-record-type-descriptor*
'rect-prefix
#f
(|#%nongenerative-uid| rect-prefix)
#f
#f
3
0))
(define effect_2587
(struct-type-install-properties!
struct:rect-prefix
'rect-prefix
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'rect-prefix))
(define rect-prefix7.1
(|#%name|
rect-prefix
(record-constructor
(make-record-constructor-descriptor struct:rect-prefix #f #f))))
(define rect-prefix?
(|#%name| rect-prefix? (record-predicate struct:rect-prefix)))
(define rect-prefix-sgn/z
(|#%name| rect-prefix-sgn/z (record-accessor struct:rect-prefix 0)))
(define rect-prefix-n
(|#%name| rect-prefix-n (record-accessor struct:rect-prefix 1)))
(define rect-prefix-start
(|#%name| rect-prefix-start (record-accessor struct:rect-prefix 2)))
(define struct:polar-prefix
(make-record-type-descriptor*
'polar-prefix
#f
(|#%nongenerative-uid| polar-prefix)
#f
#f
3
0))
(define effect_2784
(struct-type-install-properties!
struct:polar-prefix
'polar-prefix
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'polar-prefix))
(define polar-prefix8.1
(|#%name|
polar-prefix
(record-constructor
(make-record-constructor-descriptor struct:polar-prefix #f #f))))
(define polar-prefix?
(|#%name| polar-prefix? (record-predicate struct:polar-prefix)))
(define polar-prefix-sgn/z
(|#%name| polar-prefix-sgn/z (record-accessor struct:polar-prefix 0)))
(define polar-prefix-n
(|#%name| polar-prefix-n (record-accessor struct:polar-prefix 1)))
(define polar-prefix-start
(|#%name| polar-prefix-start (record-accessor struct:polar-prefix 2)))
(define init-state
(lambda (exactness_0 convert-mode_0 single-mode_0 fst_0)
(parse-state6.1
exactness_0
convert-mode_0
(eq? single-mode_0 'single)
fst_0
exactness_0)))
(define state-has-first-half?
(lambda (state_0)
(let ((fst_0 (parse-state-fst state_0)))
(if fst_0 (not (eq? fst_0 '+/-)) #f))))
(define state-set-first-half
(lambda (state_0 fst_0)
(if (parse-state? state_0)
(let ((exactness56_0 (parse-state-other-exactness state_0)))
(let ((other-exactness57_0 (parse-state-exactness state_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)
(let ((exactness_0 (parse-state-other-exactness state_0)))
(let ((convert-mode_0 (parse-state-convert-mode state_0)))
(let ((single-mode_0
(if (parse-state-can-single? state_0) 'single 'double)))
(let ((convert-mode_1 convert-mode_0) (exactness_1 exactness_0))
(begin-unsafe
(parse-state6.1
exactness_1
convert-mode_1
(eq? single-mode_0 'single)
#f
exactness_1))))))))
(define state-second-half
(lambda (state_0)
(let ((exactness_0 (parse-state-exactness state_0)))
(let ((convert-mode_0 (parse-state-convert-mode state_0)))
(let ((single-mode_0
(if (parse-state-can-single? state_0) 'single 'double)))
(let ((convert-mode_1 convert-mode_0) (exactness_1 exactness_0))
(begin-unsafe
(parse-state6.1
exactness_1
convert-mode_1
(eq? single-mode_0 'single)
#f
exactness_1))))))))
(define state->convert-mode
(lambda (state_0)
(if (parse-state? state_0) (parse-state-convert-mode state_0) state_0)))
(define state->dbz-convert-mode
(lambda (state_0)
(let ((convert-mode_0 (parse-state-convert-mode state_0)))
(if (eq? convert-mode_0 'read) 'must-read convert-mode_0))))
(define bad-digit
(lambda (c_0 s_0 state_0)
(if (char=? c_0 '#\x0)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "nul character in `~.a`" s_0)
#f)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "bad digit `~a`" c_0)
#f))))
(define bad-mixed-decimal-fraction
(lambda (s_0 state_0)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "decimal points and fractions cannot be mixed in `~.a`" s_0)
#f)))
(define bad-misplaced
(lambda (what_0 s_0 state_0)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "misplaced `~a` in `~.a`" what_0 s_0)
#f)))
(define bad-no-digits
(lambda (after_0 s_0 state_0)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "missing digits after `~a` in `~.a`" after_0 s_0)
#f)))
(define bad-extflonum-for-complex
(lambda (i_0 s_0 state_0)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "cannot combine extflonum `~a` into a complex number" i_0)
#f)))
(define struct:lazy-expt
(make-record-type-descriptor*
'lazy-expt
#f
(|#%nongenerative-uid| lazy-expt)
#f
#f
3
0))
(define effect_2624
(struct-type-install-properties!
struct:lazy-expt
'lazy-expt
3
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1 2)
#f
'lazy-expt))
(define lazy-expt9.1
(|#%name|
lazy-expt
(record-constructor
(make-record-constructor-descriptor struct:lazy-expt #f #f))))
(define lazy-expt? (|#%name| lazy-expt? (record-predicate struct:lazy-expt)))
(define lazy-expt-n
(|#%name| lazy-expt-n (record-accessor struct:lazy-expt 0)))
(define lazy-expt-radix
(|#%name| lazy-expt-radix (record-accessor struct:lazy-expt 1)))
(define lazy-expt-exp
(|#%name| lazy-expt-exp (record-accessor struct:lazy-expt 2)))
(define struct:lazy-rational
(make-record-type-descriptor*
'lazy-rational
#f
(|#%nongenerative-uid| lazy-rational)
#f
#f
2
0))
(define effect_2285
(struct-type-install-properties!
struct:lazy-rational
'lazy-rational
2
0
#f
(list (cons prop:authentic #t))
(current-inspector)
#f
'(0 1)
#f
'lazy-rational))
(define lazy-rational10.1
(|#%name|
lazy-rational
(record-constructor
(make-record-constructor-descriptor struct:lazy-rational #f #f))))
(define lazy-rational?
(|#%name| lazy-rational? (record-predicate struct:lazy-rational)))
(define lazy-rational-n
(|#%name| lazy-rational-n (record-accessor struct:lazy-rational 0)))
(define lazy-rational-d
(|#%name| lazy-rational-d (record-accessor struct:lazy-rational 1)))
(define lazy-number
(lambda (n_0 radix_0 exp_0)
(if (eq? n_0 'dbz)
n_0
(if (eq? n_0 'dbz!)
n_0
(if (if (< exp_0 30) (> exp_0 -30) #f)
(* n_0 (expt radix_0 exp_0))
(lazy-expt9.1 n_0 radix_0 exp_0))))))
(define lazy-divide
(lambda (n_0 d_0 d-exactness_0)
(if (eqv? d_0 0)
(if (eq? d-exactness_0 'exact) 'dbz! 'dbz)
(if (let ((or-part_0 (lazy-expt? n_0)))
(if or-part_0 or-part_0 (lazy-expt? d_0)))
(lazy-rational10.1 n_0 d_0)
(/ n_0 d_0)))))
(define simplify-lazy-divide
(lambda (n0_0)
(if (lazy-rational? n0_0)
(let ((n_0 (lazy-rational-n n0_0)))
(let ((d_0 (lazy-rational-d n0_0)))
(let ((n-n_0 (if (lazy-expt? n_0) (lazy-expt-n n_0) n_0)))
(let ((n-exp_0 (if (lazy-expt? n_0) (lazy-expt-exp n_0) 0)))
(let ((d-n_0 (if (lazy-expt? d_0) (lazy-expt-n d_0) d_0)))
(let ((d-exp_0 (if (lazy-expt? d_0) (lazy-expt-exp d_0) 0)))
(let ((radix_0
(if (lazy-expt? n_0)
(lazy-expt-radix n_0)
(lazy-expt-radix d_0))))
(let ((app_0 (/ n-n_0 d-n_0)))
(lazy-number app_0 radix_0 (- n-exp_0 d-exp_0))))))))))
n0_0)))
(define force-lazy-exact
(lambda (n0_0 state_0 s_0)
(let ((n_0 (simplify-lazy-divide n0_0)))
(if (let ((or-part_0 (eq? n_0 'dbz)))
(if or-part_0 or-part_0 (eq? n_0 'dbz!)))
(if (eq?
(state->convert-mode (state->dbz-convert-mode state_0))
'must-read)
(format "division by zero in `~.a`" s_0)
#f)
(if (lazy-expt? n_0)
(*
(lazy-expt-n n_0)
(expt (lazy-expt-radix n_0) (lazy-expt-exp n_0)))
n_0)))))
(define force-lazy-inexact
(let ((force-lazy-inexact_0
(|#%name|
force-lazy-inexact
(lambda (sgn/z12_0 n013_0 state14_0 s15_0 precision11_0)
(begin
(let ((n1_0 (simplify-lazy-divide n013_0)))
(if (eq? n013_0 'dbz)
(if (fx= sgn/z12_0 -1) -inf.0 +inf.0)
(if (eq? n013_0 'dbz!)
(if (eq?
(state->convert-mode
(state->dbz-convert-mode state14_0))
'must-read)
(format "division by zero in `~.a`" s15_0)
#f)
(if (lazy-expt? n1_0)
(let ((n_0 (lazy-expt-n n1_0)))
(let ((exp_0 (lazy-expt-exp n1_0)))
(let ((radix_0 (lazy-expt-radix n1_0)))
(let ((approx-expt_0
(+
(let ((app_0
(if (integer? n_0)
(integer-length n_0)
(let ((app_0
(integer-length
(numerator n_0))))
(-
app_0
(integer-length
(denominator n_0)))))))
(/ app_0 (log radix_0 2)))
exp_0)))
(if (eqv? n_0 0)
(if (fx= sgn/z12_0 -1) -0.0 0.0)
(if (> approx-expt_0 precision11_0)
(if (fx= sgn/z12_0 -1) -inf.0 +inf.0)
(if (< approx-expt_0 (- precision11_0))
(if (fx= sgn/z12_0 -1) -0.0 0.0)
(* n_0 (expt radix_0 exp_0)))))))))
(if (eqv? n1_0 0)
(if (fx= sgn/z12_0 -1) -0.0 0.0)
n1_0))))))))))
(case-lambda
((sgn/z_0 n0_0 state_0 s_0)
(force-lazy-inexact_0 sgn/z_0 n0_0 state_0 s_0 2048))
((sgn/z_0 n0_0 state_0 s_0 precision11_0)
(force-lazy-inexact_0 sgn/z_0 n0_0 state_0 s_0 precision11_0)))))
(define fast-inexact
(lambda (state_0 sgn_0 n_0 radix_0 exp_0 sgn2_0 exp2_0)
(let ((tmp_0 (parse-state-exactness state_0)))
(if (if (eq? tmp_0 'double) #t (eq? tmp_0 'approx))
(if (state-has-first-half? state_0)
#f
(if (eqv? n_0 0)
(if (fx= sgn_0 1) 0.0 -0.0)
(if (if (fixnum? n_0)
(if (< n_0 1125899906842624) (> n_0 -1125899906842624) #f)
#f)
(let ((exp_1 (+ exp_0 (* sgn2_0 exp2_0))))
(if (if (fixnum? exp_1)
(if (fx<= radix_0 10)
(fx<= -15 exp_1 15)
(fx<= -12 exp_1 12))
#f)
(let ((m_0
(unsafe-fx->fl (if (fx= sgn_0 -1) (fx- 0 n_0) n_0))))
(if (eqv? exp_1 0)
m_0
(if (not (fixnum? exp_1))
#f
(let ((fradix_0
(if (fx= radix_0 10)
10.0
(unsafe-fx->fl radix_0))))
(if (fx< exp_1 0)
(/ m_0 (expt fradix_0 (fx- 0 exp_1)))
(* m_0 (expt fradix_0 exp_1)))))))
#f))
#f)))
#f))))
(define finish.1
(|#%name|
finish
(lambda (range16_0 sgn/z18_0 n19_0 s20_0 state21_0)
(begin
(let ((fst_0 (parse-state-fst state21_0)))
(if (let ((or-part_0 (not fst_0)))
(if or-part_0 or-part_0 (eq? fst_0 '+/-)))
(let ((tmp_0 (parse-state-exactness state21_0)))
(if (eq? tmp_0 'single)
(let ((v_0
(force-lazy-inexact sgn/z18_0 n19_0 state21_0 s20_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(if (parse-state-can-single? state21_0)
(raise
(let ((app_0
(string-append
"read: single-flonums are not supported on this platform\n"
" conversion from: "
(number->string v_0))))
(|#%app|
exn:fail:unsupported
app_0
(current-continuation-marks))))
(exact->inexact v_0))))
(if (eq? tmp_0 'exact)
(if (if (eqv? n19_0 +inf.0)
#t
(if (eqv? n19_0 -inf.0) #t (eqv? n19_0 +nan.0)))
(if (eq? (state->convert-mode state21_0) 'must-read)
(format "no exact representation for ~a" n19_0)
#f)
(let ((v_0 (force-lazy-exact n19_0 state21_0 s20_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(inexact->exact v_0))))
(if (eq? tmp_0 'extended)
(if (eq?
(parse-state-convert-mode state21_0)
'number-or-false)
#f
(if (extflonum-available?)
(let ((v_0
(force-lazy-inexact
sgn/z18_0
n19_0
state21_0
s20_0
32768)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(real->extfl v_0)))
(let ((trim-s_0
(let ((app_0 (if range16_0 (car range16_0) 0)))
(trim-number
s20_0
app_0
(if range16_0
(cdr range16_0)
(string-length s20_0))))))
(string->number trim-s_0 10 'read))))
(if (if (eq? tmp_0 'double)
#t
(if (eq? tmp_0 'inexact) #t (eq? tmp_0 'approx)))
(let ((v_0
(force-lazy-inexact
sgn/z18_0
n19_0
state21_0
s20_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(exact->inexact v_0)))
(if (eq? tmp_0 'extflonum->inexact)
(if (eq? (state->convert-mode state21_0) 'must-read)
(format
"cannot convert extflonum to inexact in `~a`"
s20_0)
#f)
(if (eq? tmp_0 'extflonum->exact)
(if (eq? (state->convert-mode state21_0) 'must-read)
(format
"cannot convert extflonum to exact in `~a`"
s20_0)
#f)
(force-lazy-exact n19_0 state21_0 s20_0))))))))
(if (polar-prefix? fst_0)
(let ((pos_0 (polar-prefix-start 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)))
(let ((temp63_1 temp63_0)
(temp61_1 temp61_0)
(temp60_1 temp60_0))
(finish.1
temp64_0
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)))))))))))
(if fst_0
(if (eq? (state->convert-mode state21_0) 'must-read)
(format "missing `i` for complex number in `~.a`" s20_0)
#f)
(void)))))))))
(define finish-imaginary
(lambda (sgn/z_0 n_0 s_0 start_0 end_0 state_0)
(let ((fst_0 (parse-state-fst state_0)))
(if (if (eq? fst_0 '+/-) (fx= start_0 end_0) #f)
(let ((v_0 (finish.1 #f sgn/z_0 n_0 s_0 state_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(if (extflonum? v_0)
(bad-extflonum-for-complex v_0 s_0 state_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 ((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)))
(let ((temp77_1 temp77_0)
(temp75_1 temp75_0)
(temp74_1 temp74_0))
(finish.1
temp78_0
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)))))))))
(bad-misplaced "i" s_0 state_0))))))
(define set-exactness.1
(|#%name|
set-exactness
(lambda (override?23_0 state25_0 new-exactness26_0)
(begin
(let ((exactness_0 (parse-state-exactness state25_0)))
(let ((result-exactness_0
(if (if (eq? new-exactness26_0 'single)
#t
(eq? new-exactness26_0 'double))
(if (eq? exactness_0 'exact)
'exact
(if (eq? exactness_0 'decimal-as-exact)
(if override?23_0 new-exactness26_0 'decimal-as-exact)
new-exactness26_0))
(if (eq? new-exactness26_0 'approx)
(if (if (eq? exactness_0 'exact)
#t
(if (eq? exactness_0 'inexact)
#t
(eq? exactness_0 'decimal-as-exact)))
exactness_0
new-exactness26_0)
(if (eq? new-exactness26_0 'extended)
(if (eq? exactness_0 'inexact)
'extflonum->inexact
(if (eq? exactness_0 'exact)
'extflonum->exact
'extended))
new-exactness26_0)))))
(if (eq? exactness_0 result-exactness_0)
state25_0
(if (parse-state? 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?"
state25_0)))))))))
(define set-exactness-by-char.1
(|#%name|
set-exactness-by-char
(lambda (override?28_0 state30_0 c31_0)
(begin
(let ((temp86_0
(let ((index_0
(if (char? c31_0)
(let ((codepoint_0 (char->integer c31_0)))
(if (if (unsafe-fx>= codepoint_0 48)
(unsafe-fx< codepoint_0 117)
#f)
(let ((tbl_0
'#(1
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
1
1
2
0
0
0
0
0
1
0
0
0
0
0
0
2
3
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
1
1
2
0
0
0
0
0
1
0
0
0
0
0
0
2
3)))
(unsafe-vector*-ref
tbl_0
(unsafe-fx- codepoint_0 48)))
0))
0)))
(if (unsafe-fx< index_0 1)
(void)
(if (unsafe-fx< index_0 2)
'double
(if (unsafe-fx< index_0 3) 'single 'extended))))))
(set-exactness.1 override?28_0 state30_0 temp86_0))))))
(define trim-number
(lambda (s_0 start_0 end_0)
(if (eqv? (string-ref s_0 start_0) '#\x23)
(trim-number s_0 (fx+ 2 start_0) end_0)
(if (let ((c_0 (string-ref s_0 (fx- end_0 1))))
(let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0 or-part_0 (eqv? c_0 '#\x49))))
(trim-number s_0 start_0 (fx- end_0 1))
(substring s_0 start_0 end_0)))))
(define do-string->number.1
(|#%name|
do-string->number
(lambda (radix-set?33_0
s35_0
start36_0
end37_0
radix38_0
exactness39_0
convert-mode40_0
single-mode41_0)
(begin
(let ((c_0
(if (fx= start36_0 end37_0)
'eof
(let ((c_0 (string-ref s35_0 start36_0)))
(maybe-digit c_0 radix38_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(if (eq? (state->convert-mode convert-mode40_0) 'must-read)
(format "no digits")
#f)
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(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)))
(let ((i_0
(if (fx= next_0 end37_0)
'eof
(let ((c_1 (string-ref s35_0 next_0)))
(maybe-digit c_1 10)))))
(if (let ((or-part_0 (eqv? i_0 'eof)))
(if or-part_0 or-part_0 #f))
(if (eq?
(state->convert-mode convert-mode40_0)
'must-read)
(format
"no character after `#` indicator in `~.a`"
s35_0)
#f)
(if (let ((or-part_0 (eqv? i_0 '#\x65)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? i_0 '#\x45)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? i_0 '#\x69)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? i_0 '#\x49)))
(if or-part_3 or-part_3 #f))))))))
(if (let ((or-part_0 (eq? exactness39_0 'exact)))
(if or-part_0
or-part_0
(eq? exactness39_0 'inexact)))
(if (eq?
(state->convert-mode convert-mode40_0)
'must-read)
(format
"misplaced exactness specification at `~.a`"
(substring s35_0 start36_0 end37_0))
#f)
(let ((temp89_0 (fx+ 1 next_0)))
(let ((temp93_0
(if (let ((or-part_0 (char=? i_0 '#\x65)))
(if or-part_0
or-part_0
(char=? i_0 '#\x45)))
'exact
'inexact)))
(let ((temp94_0
(if (eq? convert-mode40_0 'read)
'must-read
convert-mode40_0)))
(let ((temp93_1 temp93_0) (temp89_1 temp89_0))
(do-string->number.1
radix-set?33_0
s35_0
temp89_1
end37_0
radix38_0
temp93_1
temp94_0
single-mode41_0))))))
(if (let ((or-part_0 (eqv? i_0 '#\x62)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? i_0 '#\x42)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? i_0 '#\x6f)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? i_0 '#\x4f)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? i_0 '#\x64)))
(if or-part_4
or-part_4
(let ((or-part_5
(eqv? i_0 '#\x44)))
(if or-part_5
or-part_5
(let ((or-part_6
(eqv? i_0 '#\x78)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv?
i_0
'#\x58)))
(if or-part_7
or-part_7
#f))))))))))))))))
(if radix-set?33_0
(if (eq?
(state->convert-mode convert-mode40_0)
'must-read)
(format
"misplaced radix specification at `~.a`"
(substring s35_0 start36_0 end37_0))
#f)
(let ((radix_0
(if (if (eqv? i_0 '#\x62)
#t
(eqv? i_0 '#\x42))
2
(if (if (eqv? i_0 '#\x6f)
#t
(eqv? i_0 '#\x4f))
8
(if (if (eqv? i_0 '#\x64)
#t
(eqv? i_0 '#\x44))
10
16)))))
(let ((temp97_0 (fx+ 1 next_0)))
(let ((temp102_0
(if (eq? convert-mode40_0 'read)
'must-read
convert-mode40_0)))
(let ((temp97_1 temp97_0))
(do-string->number.1
#t
s35_0
temp97_1
end37_0
radix_0
exactness39_0
temp102_0
single-mode41_0))))))
(if (eq?
(state->convert-mode
(if (eq? convert-mode40_0 'read)
'must-read
convert-mode40_0))
'must-read)
(format
"bad `#` indicator `~a` at `~.a`"
i_0
(substring s35_0 start36_0 end37_0))
#f))))))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(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 '#\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)))
(read-decimal
1
#f
0
s35_0
app_0
end37_0
radix38_0
(let ((temp104_0
(begin-unsafe
(parse-state6.1
exactness39_0
convert-mode40_0
(eq? single-mode41_0 'single)
#f
exactness39_0))))
(set-exactness.1 #f temp104_0 'approx))))
(bad-digit c_0 s35_0 convert-mode40_0))))))))))))
(define read-signed
(lambda (sgn_0 s_0 start_0 end_0 radix_0 state_0)
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(if (eq? (state->convert-mode state_0) 'must-read)
(format "no digits in `~.a`" s_0)
#f)
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(read-integer sgn_0 c_0 s_0 (fx+ 1 start_0) end_0 radix_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x2e))) (if or-part_0 or-part_0 #f))
(let ((app_0 (fx+ 1 start_0)))
(read-decimal
sgn_0
#f
0
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((c2_0
(if (fx= (fx+ 1 start_0) end_0)
'eof
(let ((c_1 (string-ref s_0 (fx+ 1 start_0))))
(maybe-digit c_1 radix_0)))))
(if (let ((or-part_0 (eqv? c2_0 'eof)))
(if or-part_0 or-part_0 #f))
(finish-imaginary
sgn_0
sgn_0
s_0
(fx+ 1 start_0)
end_0
state_0)
(if (let ((or-part_0 (eqv? c2_0 '#\x6e)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c2_0 '#\x4e)))
(if or-part_1 or-part_1 #f))))
(read-infinity
sgn_0
c_0
s_0
(fx+ 2 start_0)
end_0
radix_0
state_0)
(bad-digit c_0 s_0 state_0))))
(if (let ((or-part_0 (eqv? c_0 '#\x6e)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x4e)))
(if or-part_1 or-part_1 #f))))
(read-nan c_0 s_0 (fx+ 1 start_0) end_0 radix_0 state_0)
(bad-digit c_0 s_0 state_0)))))))))
(define read-integer
(lambda (sgn_0 n_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0 (|#%name| get-n (lambda () (begin (* sgn_0 n_0))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((temp109_0 (get-n_0)))
(finish.1 #f sgn_0 temp109_0 s_0 state_0))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((app_0 (+ (* n_0 radix_0) c_0)))
(read-integer
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (fx+ 1 start_0)))
(read-decimal
sgn_0
n_0
0
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x45)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x64)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x44)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x6c)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x4c)))
(if or-part_5
or-part_5
(let ((or-part_6 (eqv? c_0 '#\x66)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x46)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x73)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv?
c_0
'#\x53)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x74)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x54)))
(if or-part_11
or-part_11
#f))))))))))))))))))))))))
(let ((app_0 (get-n_0)))
(let ((app_1 (fx+ 1 start_0)))
(read-exponent
sgn_0
app_0
0
s_0
app_1
end_0
radix_0
(set-exactness-by-char.1 #f state_0 c_0))))
(if (let ((or-part_0 (eqv? c_0 '#\x2f)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (get-n_0)))
(read-rational
sgn_0
app_0
#f
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (fx+ 1 start_0)))
(read-approx
sgn_0
n_0
1
#f
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((app_0 (get-n_0)))
(let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-imag
c_0
sgn_0
app_0
app_1
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (get-n_0)))
(read-polar
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((app_0 (get-n_0)))
(finish-imaginary
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
state_0))
(bad-digit c_0 s_0 state_0))))))))))))))
(define read-decimal
(lambda (sgn_0 n_0 exp_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0
(|#%name|
get-n
(lambda ()
(begin
(if n_0
(let ((app_0 (* sgn_0 n_0)))
(lazy-number app_0 radix_0 (- exp_0)))
(bad-no-digits "." s_0 state_0)))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((or-part_0
(if n_0
(fast-inexact state_0 sgn_0 n_0 radix_0 0 -1 exp_0)
#f)))
(if or-part_0
or-part_0
(let ((v_0 (get-n_0)))
(if (let ((or-part_1 (not v_0)))
(if or-part_1 or-part_1 (string? v_0)))
v_0
(finish.1 #f sgn_0 v_0 s_0 state_0)))))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((next_0 (fx+ 1 start_0)))
(if (if (eqv? c_0 '#\x30) (fx= next_0 end_0) #f)
(read-decimal
sgn_0
(if n_0 n_0 0)
exp_0
s_0
next_0
end_0
radix_0
state_0)
(let ((app_0 (+ (* (if n_0 n_0 0) radix_0) c_0)))
(let ((app_1 (fx+ 1 exp_0)))
(read-decimal
sgn_0
app_0
app_1
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))))
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0 or-part_0 #f))
(bad-misplaced "." s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x45)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x64)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x44)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x6c)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x4c)))
(if or-part_5
or-part_5
(let ((or-part_6 (eqv? c_0 '#\x66)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x46)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x73)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv?
c_0
'#\x53)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x74)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x54)))
(if or-part_11
or-part_11
#f))))))))))))))))))))))))
(if n_0
(let ((app_0 (* sgn_0 n_0)))
(let ((app_1 (- exp_0)))
(let ((app_2 (fx+ 1 start_0)))
(read-exponent
sgn_0
app_0
app_1
s_0
app_2
end_0
radix_0
(set-exactness-by-char.1 #f state_0 c_0)))))
(bad-no-digits "." s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2f)))
(if or-part_0 or-part_0 #f))
(bad-mixed-decimal-fraction s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(if n_0
(let ((app_0 (fx- 0 exp_0)))
(read-approx
sgn_0
n_0
app_0
#t
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(bad-misplaced "#" s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(if n_0
(let ((app_0 (get-n_0)))
(let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-imag
c_0
sgn_0
app_0
app_1
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(bad-no-digits "." s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(read-polar
sgn_0
v_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(finish-imaginary
sgn_0
v_0
s_0
(fx+ 1 start_0)
end_0
state_0)))
(bad-digit c_0 s_0 state_0))))))))))))))
(define read-approx
(lambda (sgn_0 n_0 exp_0 saw-.?_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0
(|#%name|
get-n
(lambda () (begin (lazy-number (* sgn_0 n_0) radix_0 exp_0))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((temp125_0 (get-n_0)))
(finish.1 #f sgn_0 temp125_0 s_0 state_0))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(bad-misplaced "#" s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0 or-part_0 #f))
(if saw-.?_0
(bad-misplaced "." s_0 state_0)
(read-approx
sgn_0
n_0
exp_0
#t
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (if saw-.?_0 exp_0 (fx+ 1 exp_0))))
(read-approx
sgn_0
n_0
app_0
saw-.?_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x45)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x64)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x44)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x6c)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x4c)))
(if or-part_5
or-part_5
(let ((or-part_6
(eqv? c_0 '#\x66)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x46)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x73)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv?
c_0
'#\x53)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x74)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x54)))
(if or-part_11
or-part_11
#f))))))))))))))))))))))))
(let ((app_0 (* sgn_0 n_0)))
(let ((app_1 (fx+ 1 start_0)))
(read-exponent
sgn_0
app_0
exp_0
s_0
app_1
end_0
radix_0
(set-exactness-by-char.1 #f state_0 c_0))))
(if (let ((or-part_0 (eqv? c_0 '#\x2f)))
(if or-part_0 or-part_0 #f))
(if saw-.?_0
(bad-mixed-decimal-fraction s_0 state_0)
(let ((app_0 (get-n_0)))
(read-rational
sgn_0
app_0
#f
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((app_0 (get-n_0)))
(let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-imag
c_0
sgn_0
app_0
app_1
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (get-n_0)))
(read-polar
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((app_0 (get-n_0)))
(finish-imaginary
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
state_0))
(bad-digit c_0 s_0 state_0))))))))))))))
(define read-exponent
(lambda (sgn_0 sgn-n_0 exp_0 s_0 start_0 end_0 radix_0 state_0)
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x40)))
(if or-part_1 or-part_1 #f))))
(if (eq? (state->convert-mode state_0) 'must-read)
(format "empty exponent `~.a`" s_0)
#f)
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(read-signed-exponent
sgn_0
sgn-n_0
exp_0
1
c_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((sgn2_0 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-signed-exponent
sgn_0
sgn-n_0
exp_0
sgn2_0
#f
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x23)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x2f)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x65)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x45)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x64)))
(if or-part_5
or-part_5
(let ((or-part_6 (eqv? c_0 '#\x44)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x6c)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x4c)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv? c_0 '#\x66)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x46)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x73)))
(if or-part_11
or-part_11
(let ((or-part_12
(eqv?
c_0
'#\x53)))
(if or-part_12
or-part_12
(let ((or-part_13
(eqv?
c_0
'#\x74)))
(if or-part_13
or-part_13
(let ((or-part_14
(eqv?
c_0
'#\x54)))
(if or-part_14
or-part_14
#f))))))))))))))))))))))))))))))
(bad-misplaced c_0 s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(if (state-has-first-half? state_0)
(if (eq? (state->convert-mode state_0) 'must-read)
(format "empty exponent `~.a`" s_0)
#f)
(bad-misplaced "i" s_0 state_0))
(bad-digit c_0 s_0 state_0)))))))))
(define read-signed-exponent
(lambda (sgn_0 sgn-n_0 exp_0 sgn2_0 exp2_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0
(|#%name|
get-n
(lambda ()
(begin
(if exp2_0
(lazy-number sgn-n_0 radix_0 (+ exp_0 (* sgn2_0 exp2_0)))
(if (eq? (state->convert-mode state_0) 'must-read)
(format "empty exponent `~.a`" s_0)
#f)))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((or-part_0
(if exp2_0
(if (number? sgn-n_0)
(fast-inexact
state_0
(if (eqv? sgn-n_0 0) sgn_0 1)
sgn-n_0
radix_0
exp_0
sgn2_0
exp2_0)
#f)
#f)))
(if or-part_0
or-part_0
(let ((v_0 (get-n_0)))
(if (let ((or-part_1 (not v_0)))
(if or-part_1 or-part_1 (string? v_0)))
v_0
(finish.1 #f sgn_0 v_0 s_0 state_0)))))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((new-exp2_0 (+ (if exp2_0 (* exp2_0 radix_0) 0) c_0)))
(read-signed-exponent
sgn_0
sgn-n_0
exp_0
sgn2_0
new-exp2_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(let ((app_0 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-imag
c_0
sgn_0
v_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))))
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x23)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x2f)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x65)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x45)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x64)))
(if or-part_5
or-part_5
(let ((or-part_6 (eqv? c_0 '#\x44)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x6c)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x4c)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv?
c_0
'#\x66)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x46)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x73)))
(if or-part_11
or-part_11
(let ((or-part_12
(eqv?
c_0
'#\x53)))
(if or-part_12
or-part_12
(let ((or-part_13
(eqv?
c_0
'#\x74)))
(if or-part_13
or-part_13
(let ((or-part_14
(eqv?
c_0
'#\x54)))
(if or-part_14
or-part_14
#f))))))))))))))))))))))))))))))
(bad-misplaced c_0 s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(read-polar
sgn_0
v_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(finish-imaginary
sgn_0
v_0
s_0
(fx+ 1 start_0)
end_0
state_0)))
(bad-digit c_0 s_0 state_0)))))))))))
(define read-infinity
(lambda (sgn_0 c_0 s_0 start_0 end_0 radix_0 state_0)
(let ((fail_0
(|#%name| fail (lambda () (begin (bad-digit c_0 s_0 state_0))))))
(let ((start+n_0 (fx+ start_0 0)))
(let ((var_0
(if (fx= start+n_0 end_0) 'eof (string-ref s_0 start+n_0))))
(if (if (eqv? var_0 '#\x66) #t (eqv? var_0 '#\x46))
(let ((fail_1 (|#%name| fail (lambda () (begin (fail_0))))))
(let ((start+n_1 (fx+ start_0 1)))
(let ((var_1
(if (fx= start+n_1 end_0)
'eof
(string-ref s_0 start+n_1))))
(if (eqv? var_1 '#\x2e)
(let ((fail_2
(|#%name| fail (lambda () (begin (fail_1))))))
(let ((start+n_2 (fx+ start_0 2)))
(let ((var_2
(if (fx= start+n_2 end_0)
'eof
(string-ref s_0 start+n_2))))
(if (if (eqv? var_2 '#\x30)
#t
(if (eqv? var_2 '#\x66)
#t
(if (eqv? var_2 '#\x74)
#t
(if (eqv? var_2 '#\x46)
#t
(eqv? var_2 '#\x54)))))
(let ((n_0 (if (negative? sgn_0) -inf.0 +inf.0)))
(let ((new-state_0
(let ((temp135_0
(string-ref s_0 (fx+ start_0 2))))
(set-exactness-by-char.1
#t
state_0
temp135_0))))
(let ((c2_0
(if (fx= (fx+ 3 start_0) end_0)
'eof
(let ((c_1
(string-ref
s_0
(fx+ 3 start_0))))
(maybe-digit c_1 radix_0)))))
(if (let ((or-part_0 (eqv? c2_0 'eof)))
(if or-part_0 or-part_0 #f))
(finish.1 #f sgn_0 n_0 s_0 new-state_0)
(if (let ((or-part_0 (eqv? c2_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1
(eqv? c2_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((app_0
(if (eqv? c2_0 '#\x2b) 1 -1)))
(read-imag
c2_0
sgn_0
n_0
app_0
s_0
(fx+ 4 start_0)
end_0
radix_0
new-state_0))
(if (let ((or-part_0 (eqv? c2_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(read-polar
sgn_0
n_0
s_0
(fx+ 4 start_0)
end_0
radix_0
new-state_0)
(if (let ((or-part_0
(eqv? c2_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1
(eqv? c2_0 '#\x49)))
(if or-part_1
or-part_1
#f))))
(finish-imaginary
sgn_0
n_0
s_0
(fx+ 4 start_0)
end_0
new-state_0)
(bad-digit c_0 s_0 state_0))))))))
(fail_2)))))
(fail_1)))))
(fail_0)))))))
(define read-nan
(lambda (c_0 s_0 start_0 end_0 radix_0 state_0)
(let ((fail_0
(|#%name| fail (lambda () (begin (bad-digit c_0 s_0 state_0))))))
(let ((start+n_0 (fx+ start_0 0)))
(let ((var_0
(if (fx= start+n_0 end_0) 'eof (string-ref s_0 start+n_0))))
(if (if (eqv? var_0 '#\x61) #t (eqv? var_0 '#\x41))
(let ((fail_1 (|#%name| fail (lambda () (begin (fail_0))))))
(let ((start+n_1 (fx+ start_0 1)))
(let ((var_1
(if (fx= start+n_1 end_0)
'eof
(string-ref s_0 start+n_1))))
(if (if (eqv? var_1 '#\x6e) #t (eqv? var_1 '#\x4e))
(let ((fail_2
(|#%name| fail (lambda () (begin (fail_1))))))
(let ((start+n_2 (fx+ start_0 2)))
(let ((var_2
(if (fx= start+n_2 end_0)
'eof
(string-ref s_0 start+n_2))))
(if (eqv? var_2 '#\x2e)
(let ((fail_3
(|#%name|
fail
(lambda () (begin (fail_2))))))
(let ((start+n_3 (fx+ start_0 3)))
(let ((var_3
(if (fx= start+n_3 end_0)
'eof
(string-ref s_0 start+n_3))))
(if (if (eqv? var_3 '#\x30)
#t
(if (eqv? var_3 '#\x66)
#t
(if (eqv? var_3 '#\x74)
#t
(if (eqv? var_3 '#\x46)
#t
(eqv? var_3 '#\x54)))))
(let ((new-state_0
(let ((temp142_0
(string-ref
s_0
(fx+ start_0 3))))
(set-exactness-by-char.1
#t
state_0
temp142_0))))
(let ((c2_0
(if (fx= (fx+ 4 start_0) end_0)
'eof
(let ((c_1
(string-ref
s_0
(fx+ 4 start_0))))
(maybe-digit c_1 radix_0)))))
(if (let ((or-part_0 (eqv? c2_0 'eof)))
(if or-part_0 or-part_0 #f))
(finish.1
#f
1
+nan.0
s_0
new-state_0)
(if (let ((or-part_0
(eqv? c2_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1
(eqv? c2_0 '#\x2d)))
(if or-part_1
or-part_1
#f))))
(let ((app_0 +nan.0))
(let ((app_1
(if (eqv? c2_0 '#\x2b)
1
-1)))
(read-imag
c2_0
1
app_0
app_1
s_0
(fx+ 5 start_0)
end_0
radix_0
new-state_0)))
(if (let ((or-part_0
(eqv? c2_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((app_0 +nan.0))
(read-polar
1
app_0
s_0
(fx+ 5 start_0)
end_0
radix_0
new-state_0))
(if (let ((or-part_0
(eqv? c2_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1
(eqv?
c2_0
'#\x49)))
(if or-part_1
or-part_1
#f))))
(let ((app_0 +nan.0))
(finish-imaginary
1
app_0
s_0
(fx+ 5 start_0)
end_0
new-state_0))
(bad-digit
c_0
s_0
state_0)))))))
(fail_3)))))
(fail_2)))))
(fail_1)))))
(fail_0)))))))
(define read-rational
(lambda (sgn_0 sgn-n_0 d_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0
(|#%name|
get-n
(lambda ()
(begin
(if d_0
(lazy-divide sgn-n_0 d_0 'exact)
(bad-no-digits "/" s_0 state_0)))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(finish.1 #f sgn_0 v_0 s_0 state_0)))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((app_0 (+ (if d_0 (* d_0 radix_0) 0) c_0)))
(read-rational
sgn_0
sgn-n_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0 or-part_0 #f))
(bad-mixed-decimal-fraction s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x23)))
(if or-part_0 or-part_0 #f))
(if d_0
(let ((app_0 (fx+ 1 start_0)))
(read-denom-approx
sgn_0
sgn-n_0
d_0
1
s_0
app_0
end_0
radix_0
(set-exactness.1 #f state_0 'approx)))
(bad-misplaced "#" s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x45)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x64)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x44)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x6c)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x4c)))
(if or-part_5
or-part_5
(let ((or-part_6
(eqv? c_0 '#\x66)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x46)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x73)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv?
c_0
'#\x53)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x74)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x54)))
(if or-part_11
or-part_11
#f))))))))))))))))))))))))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(let ((app_0 (fx+ 1 start_0)))
(read-exponent
sgn_0
v_0
0
s_0
app_0
end_0
radix_0
(set-exactness-by-char.1 #f state_0 c_0)))))
(if (let ((or-part_0 (eqv? c_0 '#\x2f)))
(if or-part_0 or-part_0 #f))
(bad-misplaced "/" s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(let ((app_0 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-imag
c_0
sgn_0
v_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))))
(if (let ((or-part_0 (eqv? c_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(read-polar
sgn_0
v_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((v_0 (get-n_0)))
(if (let ((or-part_0 (not v_0)))
(if or-part_0 or-part_0 (string? v_0)))
v_0
(finish-imaginary
sgn_0
v_0
s_0
(fx+ 1 start_0)
end_0
state_0)))
(bad-digit c_0 s_0 state_0))))))))))))))
(define read-denom-approx
(lambda (sgn_0 sgn-n_0 d_0 exp_0 s_0 start_0 end_0 radix_0 state_0)
(let ((get-n_0
(|#%name|
get-n
(lambda ()
(begin
(lazy-divide
sgn-n_0
(lazy-number d_0 radix_0 exp_0)
'approx))))))
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(let ((temp157_0 (get-n_0)))
(finish.1 #f sgn_0 temp157_0 s_0 state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x23))) (if or-part_0 or-part_0 #f))
(let ((app_0 (fx+ 1 exp_0)))
(read-denom-approx
sgn_0
sgn-n_0
d_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(bad-misplaced "#" s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x2e)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2f)))
(if or-part_1 or-part_1 #f))))
(bad-misplaced c_0 s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x65)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x45)))
(if or-part_1
or-part_1
(let ((or-part_2 (eqv? c_0 '#\x64)))
(if or-part_2
or-part_2
(let ((or-part_3 (eqv? c_0 '#\x44)))
(if or-part_3
or-part_3
(let ((or-part_4 (eqv? c_0 '#\x6c)))
(if or-part_4
or-part_4
(let ((or-part_5 (eqv? c_0 '#\x4c)))
(if or-part_5
or-part_5
(let ((or-part_6
(eqv? c_0 '#\x66)))
(if or-part_6
or-part_6
(let ((or-part_7
(eqv? c_0 '#\x46)))
(if or-part_7
or-part_7
(let ((or-part_8
(eqv? c_0 '#\x73)))
(if or-part_8
or-part_8
(let ((or-part_9
(eqv?
c_0
'#\x53)))
(if or-part_9
or-part_9
(let ((or-part_10
(eqv?
c_0
'#\x74)))
(if or-part_10
or-part_10
(let ((or-part_11
(eqv?
c_0
'#\x54)))
(if or-part_11
or-part_11
#f))))))))))))))))))))))))
(let ((app_0 (get-n_0)))
(let ((app_1 (fx+ 1 start_0)))
(read-exponent
sgn_0
app_0
0
s_0
app_1
end_0
radix_0
(set-exactness-by-char.1 #f state_0 c_0))))
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((app_0 (get-n_0)))
(let ((app_1 (if (eqv? c_0 '#\x2b) 1 -1)))
(read-imag
c_0
sgn_0
app_0
app_1
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0)))
(if (let ((or-part_0 (eqv? c_0 '#\x40)))
(if or-part_0 or-part_0 #f))
(let ((app_0 (get-n_0)))
(read-polar
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
state_0))
(if (let ((or-part_0 (eqv? c_0 '#\x69)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x49)))
(if or-part_1 or-part_1 #f))))
(let ((app_0 (get-n_0)))
(finish-imaginary
sgn_0
app_0
s_0
(fx+ 1 start_0)
end_0
state_0))
(bad-digit c_0 s_0 state_0)))))))))))))
(define read-imag
(lambda (c_0 real-sgn_0 real_0 sgn_0 s_0 start_0 end_0 radix_0 state_0)
(if (let ((or-part_0 (state-has-first-half? state_0)))
(if or-part_0
or-part_0
(eq? 'extended (parse-state-exactness state_0))))
(bad-misplaced c_0 s_0 state_0)
(read-signed
sgn_0
s_0
start_0
end_0
radix_0
(state-set-first-half
state_0
(rect-prefix7.1 real-sgn_0 real_0 (fx- start_0 1)))))))
(define read-polar
(lambda (real-sgn_0 real_0 s_0 start_0 end_0 radix_0 state_0)
(if (let ((or-part_0 (state-has-first-half? state_0)))
(if or-part_0
or-part_0
(eq? 'extended (parse-state-exactness state_0))))
(bad-misplaced "@" s_0 state_0)
(let ((c_0
(if (fx= start_0 end_0)
'eof
(let ((c_0 (string-ref s_0 start_0)))
(maybe-digit c_0 radix_0)))))
(if (let ((or-part_0 (eqv? c_0 'eof))) (if or-part_0 or-part_0 #f))
(bad-misplaced "@" s_0 state_0)
(if (let ((or-part_0 (eqv? c_0 '#\x2b)))
(if or-part_0
or-part_0
(let ((or-part_1 (eqv? c_0 '#\x2d)))
(if or-part_1 or-part_1 #f))))
(let ((new-state_0
(state-set-first-half
state_0
(polar-prefix8.1 real-sgn_0 real_0 start_0))))
(let ((app_0 (if (eq? c_0 '#\x2b) 1 -1)))
(read-signed
app_0
s_0
(fx+ 1 start_0)
end_0
radix_0
new-state_0)))
(if (let ((or-part_0 (fixnum? c_0))) (if or-part_0 or-part_0 #f))
(let ((new-state_0
(state-set-first-half
state_0
(polar-prefix8.1 real-sgn_0 real_0 start_0))))
(read-integer
1
c_0
s_0
(fx+ 1 start_0)
end_0
radix_0
new-state_0))
(bad-digit c_0 s_0 state_0))))))))
(define read-symbol-or-number.1
(|#%name|
read-symbol-or-number
(lambda (extra-prefix2_0 mode1_0 init-c5_0 in6_0 orig-config7_0)
(begin
(let ((config_0
(if (string? mode1_0)
(override-parameter 1/read-cdot orig-config7_0 #f)
orig-config7_0)))
(let ((rt_0
(begin-unsafe
(read-config/inner-readtable
(read-config/outer-inner config_0)))))
(let ((c1_0
(if rt_0
(if (let ((or-part_0 (eq? mode1_0 'symbol-or-number)))
(if or-part_0
or-part_0
(eq? mode1_0 'symbol/indirect)))
(readtable-symbol-parser rt_0)
#f)
#f)))
(if c1_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
(check-parameter read-case-sensitive config_0)))
(begin
(if extra-prefix2_0
(accum-string-add! accum-str_0 extra-prefix2_0)
(void))
(let ((source_0
(begin-unsafe
(read-config/inner-source
(read-config/outer-inner config_0)))))
(let ((unexpected-quoted_0
(|#%name|
unexpected-quoted
(lambda (c_0 after-c_0)
(begin
(let ((temp12_0
"~a following `~a` in ~a"))
(let ((temp13_0
(if (eof-object? c_0)
"end-of-file"
"non-character")))
(let ((temp15_0
(if (eq? mode1_0 'keyword)
"keyword"
(if (string? mode1_0)
"number"
"symbol"))))
(let ((temp13_1 temp13_0)
(temp12_1 temp12_0))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in6_0
config_0
temp12_1
(list
temp13_1
after-c_0
temp15_0)))))))))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (init-c_0
pipe-quote-c_0
foldcase-from_0)
(begin
(let ((c_0
(if init-c_0
init-c_0
(let ((c_0
(peek-char-or-special
in6_0
0
'special
source_0)))
(if (eq? c_0 'special)
(special1.1 'special)
c_0)))))
(let ((ec_0
(if (let ((or-part_0 (not rt_0)))
(if or-part_0
or-part_0
(not (char? c_0))))
c_0
(*readtable-effective-char
rt_0
c_0))))
(if (if pipe-quote-c_0
(not (char? ec_0))
#f)
(begin
(if init-c_0
(void)
(begin-unsafe
(begin
(read-char-or-special
in6_0
special1.1
(begin-unsafe
(read-config/inner-source
(read-config/outer-inner
config_0))))
(void))))
(unexpected-quoted_0
c_0
pipe-quote-c_0))
(if (if (not pipe-quote-c_0)
(readtable-char-delimiter?
rt_0
c_0
config_0)
#f)
(if case-sens?_0
(void)
(accum-string-convert!
accum-str_0
string-foldcase
foldcase-from_0))
(if (if pipe-quote-c_0
(char=? c_0 pipe-quote-c_0)
#f)
(begin
(if init-c_0
(void)
(begin-unsafe
(begin
(read-char in6_0)
(void))))
(loop_0
#f
#f
(begin-unsafe
(accum-string-pos
accum-str_0))))
(if (if (char=? ec_0 '#\x7c)
(check-parameter
read-accept-bar-quote
config_0)
#f)
(begin
(if init-c_0
(void)
(begin-unsafe
(begin
(read-char in6_0)
(void))))
(set! quoted-ever?_0 #t)
(if case-sens?_0
(void)
(accum-string-convert!
accum-str_0
string-foldcase
foldcase-from_0))
(loop_0
#f
c_0
(begin-unsafe
(accum-string-pos
accum-str_0))))
(if (if (char=? ec_0 '#\x5c)
(not pipe-quote-c_0)
#f)
(begin
(if init-c_0
(void)
(begin-unsafe
(begin
(read-char in6_0)
(void))))
(let ((next-c_0
(read-char-or-special
in6_0
special1.1
source_0)))
(begin
(if (char? next-c_0)
(void)
(unexpected-quoted_0
next-c_0
c_0))
(if (if pipe-quote-c_0
pipe-quote-c_0
case-sens?_0)
(void)
(accum-string-convert!
accum-str_0
string-foldcase
foldcase-from_0))
(accum-string-add!
accum-str_0
next-c_0)
(set! quoted-ever?_0
#t)
(loop_0
#f
#f
(begin-unsafe
(accum-string-pos
accum-str_0))))))
(begin
(if init-c_0
(void)
(begin-unsafe
(begin
(read-char in6_0)
(void))))
(accum-string-add!
accum-str_0
c_0)
(loop_0
#f
pipe-quote-c_0
foldcase-from_0))))))))))))))
(loop_0 init-c5_0 #f 0))
(let ((str_0
(accum-string-get!.1
0
accum-str_0
config_0)))
(begin
(if (if (= 1 (string-length str_0))
(if (not quoted-ever?_0)
(char=?
'#\x2e
(effective-char
(string-ref str_0 0)
config_0))
#f)
#f)
(let ((temp20_0 "illegal use of `.`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in6_0
config_0
temp20_0
(list)))
(void))
(let ((num_0
(if (let ((or-part_0
(eq?
mode1_0
'symbol-or-number)))
(if or-part_0
or-part_0
(string? mode1_0)))
(if (not quoted-ever?_0)
(let ((app_0
(if (string? mode1_0)
(string-append
mode1_0
str_0)
str_0)))
(let ((app_1
(if (check-parameter
1/read-decimal-as-inexact
config_0)
'decimal-as-inexact
'decimal-as-exact)))
(unchecked-string->number
app_0
10
'read
app_1
(if (check-parameter
1/read-single-flonum
config_0)
'single
'double))))
#f)
#f)))
(begin
(if (string? num_0)
(let ((temp23_0 "~a"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in6_0
config_0
temp23_0
(list num_0)))
(void))
(if (if (not num_0) (string? mode1_0) #f)
(let ((temp27_0 "bad number: `~a`"))
(let ((temp28_0
(string-append mode1_0 str_0)))
(let ((temp27_1 temp27_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in6_0
config_0
temp27_1
(list temp28_0)))))
(void))
(wrap
(if num_0
num_0
(let ((or-part_0
(if (eq? mode1_0 'keyword)
(string->keyword str_0)
#f)))
(if or-part_0
or-part_0
(string->symbol str_0))))
in6_0
config_0
str_0))))))))))))))))))))
(define read-fixnum
(lambda (read-one_0 init-c_0 in_0 config_0)
(let ((c_0
(read-char/skip-whitespace-and-comments
init-c_0
read-one_0
in_0
config_0)))
(call-with-values
(lambda () (port-next-location* in_0 c_0))
(case-lambda
((line_0 col_0 pos_0)
(let ((v_0 (read-number-literal c_0 in_0 config_0 "#e")))
(if (fixnum? v_0)
v_0
(if (eof-object? v_0)
v_0
(let ((temp2_0 (reading-at config_0 line_0 col_0 pos_0)))
(let ((temp3_0 "expected a fixnum, found ~a"))
(let ((temp2_1 temp2_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
temp2_1
temp3_0
(list v_0)))))))))
(args (raise-binding-result-arity-error 3 args)))))))
(define read-flonum
(lambda (read-one_0 init-c_0 in_0 config_0)
(let ((c_0
(read-char/skip-whitespace-and-comments
init-c_0
read-one_0
in_0
config_0)))
(call-with-values
(lambda () (port-next-location* in_0 c_0))
(case-lambda
((line_0 col_0 pos_0)
(let ((v_0 (read-number-literal c_0 in_0 config_0 "#i")))
(if (flonum? v_0)
v_0
(if (eof-object? v_0)
v_0
(let ((temp6_0 (reading-at config_0 line_0 col_0 pos_0)))
(let ((temp7_0 "expected a flonum, found ~a"))
(let ((temp6_1 temp6_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
temp6_1
temp7_0
(list v_0)))))))))
(args (raise-binding-result-arity-error 3 args)))))))
(define read-number-literal
(lambda (c_0 in_0 config_0 mode_0)
(if (not (char? c_0))
c_0
(read-symbol-or-number.1 #f mode_0 c_0 in_0 config_0))))
(define read-vector.1
(|#%name|
read-vector
(lambda (length2_0
mode1_0
read-one5_0
opener-c6_0
opener7_0
closer8_0
in9_0
config10_0)
(begin
(let ((read-one-element_0
(if (eq? mode1_0 'any)
read-one5_0
(if (eq? mode1_0 'fixnum)
(|#%name|
read-one-element
(lambda (init-c_0 in_0 config_0)
(begin (read-fixnum read-one5_0 init-c_0 in_0 config_0))))
(if (eq? mode1_0 'flonum)
(|#%name|
read-one-element
(lambda (init-c_0 in_0 config_0)
(begin
(read-flonum read-one5_0 init-c_0 in_0 config_0))))
(void))))))
(let ((seq_0
(read-unwrapped-sequence.1
#f
unsafe-undefined
unsafe-undefined
#f
read-one5_0
read-one-element_0
opener-c6_0
opener7_0
closer8_0
in9_0
config10_0)))
(let ((vec_0
(if (not length2_0)
(if (eq? mode1_0 'any)
(list->vector seq_0)
(if (eq? mode1_0 'fixnum)
(let ((len_0 (length seq_0)))
(begin
(if (exact-nonnegative-integer? len_0)
(void)
(raise-argument-error
'for/fxvector
"exact-nonnegative-integer?"
len_0))
(let ((v_0 (make-fxvector len_0 0)))
(begin
(if (zero? len_0)
(void)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((i_1
(let ((i_1
(begin
(if (fixnum?
e_0)
(unsafe-fxvector-set!
v_0
i_0
e_0)
(begin-unsafe
(raise-argument-error
'for*/vector
"fixnum?"
e_0)))
(unsafe-fx+
1
i_0))))
(values i_1))))
(if (if (not
(let ((x_0
(list
e_0)))
(unsafe-fx=
i_1
len_0)))
#t
#f)
(for-loop_0 i_1 rest_0)
i_1))))
i_0))))))
(for-loop_0 0 seq_0))))
v_0))))
(if (eq? mode1_0 'flonum)
(let ((len_0 (length seq_0)))
(begin
(if (exact-nonnegative-integer? len_0)
(void)
(raise-argument-error
'for/flvector
"exact-nonnegative-integer?"
len_0))
(let ((v_0 (make-flvector len_0 0.0)))
(begin
(if (zero? len_0)
(void)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((i_1
(let ((i_1
(begin
(if (flonum?
e_0)
(unsafe-flvector-set!
v_0
i_0
e_0)
(begin-unsafe
(raise-argument-error
'for*/vector
"flonum?"
e_0)))
(unsafe-fx+
1
i_0))))
(values i_1))))
(if (if (not
(let ((x_0
(list
e_0)))
(unsafe-fx=
i_1
len_0)))
#t
#f)
(for-loop_0 i_1 rest_0)
i_1))))
i_0))))))
(for-loop_0 0 seq_0))))
v_0))))
(void))))
(let ((len_0 (length seq_0)))
(if (= length2_0 len_0)
(list->vector seq_0)
(if (< length2_0 len_0)
(let ((temp22_0
"~avector length ~a is too small, ~a values provided"))
(let ((temp23_0
(if (eq? mode1_0 'any)
""
(if (eq? mode1_0 'fixnum)
"fx"
(if (eq? mode1_0 'flonum)
"fl"
(void))))))
(let ((temp22_1 temp22_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in9_0
config10_0
temp22_1
(list temp23_0 length2_0 len_0)))))
(let ((last-or_0
(|#%name|
last-or
(lambda (v_0)
(begin
(if (null? seq_0)
(wrap v_0 in9_0 config10_0 #f)
(letrec*
((loop_0
(|#%name|
loop
(lambda (seq_1)
(begin
(if (null? (cdr seq_1))
(car seq_1)
(loop_0 (cdr seq_1))))))))
(loop_0 seq_0))))))))
(begin
(if (>= (integer-length length2_0) 48)
(raise
(|#%app|
exn:fail:out-of-memory
"out of memory"
(current-continuation-marks)))
(void))
(let ((vec_0
(if (eq? mode1_0 'any)
(make-vector length2_0 (last-or_0 0))
(if (eq? mode1_0 'fixnum)
(make-fxvector
length2_0
(last-or_0 0))
(if (eq? mode1_0 'flonum)
(make-flvector
length2_0
(last-or_0 0.0))
(void))))))
(begin
(if (eq? mode1_0 'any)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((e_0
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(begin
(vector-set!
vec_0
pos_0
e_0)
(for-loop_0
rest_0
(+ pos_0 1)))))
(values)))))))
(for-loop_0 seq_0 0)))
(void))
(if (eq? mode1_0 'fixnum)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((e_0
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(fxvector-set!
vec_0
pos_0
e_0)
(for-loop_0
rest_0
(+ pos_0 1)))))
(values)))))))
(for-loop_0 seq_0 0)))
(void))
(if (eq? mode1_0 'flonum)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0 pos_0)
(begin
(if (if (pair? lst_0)
#t
#f)
(let ((e_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(begin
(flvector-set!
vec_0
pos_0
e_0)
(for-loop_0
rest_0
(+ pos_0 1)))))
(values)))))))
(for-loop_0 seq_0 0)))
(void))
(void))))
vec_0))))))))))
(wrap
(if (begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config10_0)))
(vector->immutable-vector vec_0)
vec_0)
in9_0
config10_0
opener7_0))))))))
(define read-fixnum-or-flonum-vector
(lambda (read-one_0 dispatch-c_0 c_0 c2_0 in_0 config_0)
(let ((vector-mode_0 (if (char=? c2_0 '#\x78) 'fixnum 'flonum)))
(begin
(begin-unsafe (begin (read-char in_0) (void)))
(begin
(if (begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config_0)))
(let ((temp28_0 "literal f~avectors not allowed"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
config_0
temp28_0
(list c2_0)))
(void))
(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
'#\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)
(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)))
(begin
(accum-string-add! accum-str_0 init-c_0)
(let ((init-v_0 (digit->number init-c_0)))
(let ((v_0
(read-digits.1
10
init-v_0
+inf.0
init-v_0
in_0
config_0
accum-str_0)))
(let ((app_0 (accum-string-get!.1 0 accum-str_0 config_0)))
(values
v_0
app_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))))))))))
(define read-struct
(lambda (read-one_0 dispatch-c_0 in_0 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
'#\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)
(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 (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))
(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 ((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)))
(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
(lambda (init-c_0 in_1 config_1)
(|#%app| read-one_0 init-c_0 in_1 (disable-wrapping config_1)))))
(read-unwrapped-sequence.1
'all
unsafe-undefined
temp36_0
#f
unsafe-undefined
read-one_0
opener-c_0
opener_0
closer_0
in_0
config_0))))
(define read-vector-or-graph
(lambda (read-one_0 dispatch-c_0 init-c_0 in_0 config_0)
(let ((accum-str_0 (accum-string-init! config_0)))
(begin
(accum-string-add! accum-str_0 init-c_0)
(let ((init-v_0 (digit->number init-c_0)))
(let ((v_0
(read-digits.1
10
init-v_0
+inf.0
init-v_0
in_0
config_0
accum-str_0)))
(call-with-values
(lambda () (port-next-location in_0))
(case-lambda
((post-line_0 post-col_0 post-pos_0)
(let ((get-accum_0
(|#%name|
get-accum
(lambda (c_0)
(begin
(format
"~a~a~a"
dispatch-c_0
(accum-string-get!.1 0 accum-str_0 config_0)
c_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)
(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)
(begin
(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-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)
(begin
(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
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)
(let ((st_0
(begin-unsafe
(read-config/inner-st (read-config/outer-inner config_0)))))
(let ((or-part_0 (read-config-state-graph st_0)))
(if or-part_0
or-part_0
(let ((ht_0 (make-hasheqv)))
(begin (set-read-config-state-graph! st_0 ht_0) ht_0)))))))
(define coerce-key
(lambda (key_0 config_0)
(let ((for-syntax?_0
(begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config_0)))))
(|#%app|
(begin-unsafe
(read-config/inner-coerce-key (read-config/outer-inner config_0)))
for-syntax?_0
key_0))))
(define read-hash
(lambda (read-one_0 dispatch-c_0 init-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 init-c_0)
(let ((get-next!_0
(|#%name|
get-next!
(lambda (expect-c_0 expect-alt-c_0)
(begin
(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)))))))))
(begin
(get-next!_0 '#\x61 '#\x41)
(begin
(get-next!_0 '#\x73 '#\x53)
(begin
(get-next!_0 '#\x68 '#\x48)
(call-with-values
(lambda ()
(letrec*
((loop_0
(|#%name|
loop
(lambda (mode_0)
(begin
(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)
(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 '#\x45))
(begin
(accum-string-add!
accum-str_0
c_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 ((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)))))))))))))))))))
(loop_0 'equal)))
(case-lambda
((content_0 opener_0 mode_0)
(let ((graph?_0
(if (read-config-state-graph
(begin-unsafe
(read-config/inner-st
(read-config/outer-inner config_0))))
#t
#f)))
(wrap
(if (eq? mode_0 'equal)
(if graph?_0
(make-hash-placeholder content_0)
(make-immutable-hash content_0))
(if (eq? mode_0 'eq)
(if graph?_0
(make-hasheq-placeholder content_0)
(make-immutable-hasheq content_0))
(if (eq? mode_0 'eqv)
(if graph?_0
(make-hasheqv-placeholder content_0)
(make-immutable-hasheqv content_0))
(void))))
in_0
config_0
opener_0)))
(args (raise-binding-result-arity-error 3 args)))))))))))))
(define make-read-one-key+value
(lambda (read-one_0 overall-opener-c_0 overall-closer-ec_0 prefix-end-pos_0)
(lambda (init-c_0 in_0 config_0)
(let ((c_0
(read-char/skip-whitespace-and-comments
init-c_0
read-one_0
in_0
config_0)))
(call-with-values
(lambda () (port-next-location* in_0 c_0))
(case-lambda
((open-line_0 open-col_0 open-pos_0)
(let ((ec_0 (effective-char c_0 config_0)))
(let ((elem-config_0 (next-readtable config_0)))
(let ((closer_0
(if (eqv? ec_0 '#\x28)
'#\x29
(if (eqv? ec_0 '#\x5b)
(if (check-parameter
1/read-square-bracket-as-paren
config_0)
'#\x5d
#f)
(if (eqv? ec_0 '#\x7b)
(if (check-parameter
1/read-curly-brace-as-paren
config_0)
'#\x7d
#f)
#f)))))
(if (not closer_0)
(if (eof-object? c_0)
(let ((temp58_0 "expected ~a to close `~a`"))
(let ((temp59_0
(begin-unsafe
(effective-char-names
overall-closer-ec_0
config_0
"closer"))))
(let ((temp58_1 temp58_0))
(reader-error.1
unsafe-undefined
c_0
prefix-end-pos_0
unsafe-undefined
in_0
config_0
temp58_1
(list temp59_0 overall-opener-c_0)))))
(if (char-closer? ec_0 config_0)
(let ((temp62_0
(reading-at
config_0
open-line_0
open-col_0
open-pos_0)))
(let ((temp63_0 "~a"))
(let ((temp64_0
(indentation-unexpected-closer-message
ec_0
c_0
config_0)))
(let ((temp63_1 temp63_0) (temp62_1 temp62_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
temp62_1
temp63_1
(list temp64_0))))))
(let ((v_0
(|#%app|
read-one_0
c_0
in_0
(keep-comment elem-config_0))))
(if (1/special-comment? v_0)
(|#%app|
(make-read-one-key+value
read-one_0
overall-opener-c_0
overall-closer-ec_0
prefix-end-pos_0)
#f
in_0
config_0)
(let ((temp66_0
(reading-at
config_0
open-line_0
open-col_0
open-pos_0)))
(let ((temp67_0
"expected ~a to start a hash pair"))
(let ((temp68_0 (all-openers-str config_0)))
(let ((temp67_1 temp67_0) (temp66_1 temp66_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
temp66_1
temp67_1
(list temp68_0))))))))))
(let ((k_0
(|#%app|
read-one_0
#f
in_0
(disable-wrapping elem-config_0))))
(let ((dot-c_0
(read-char/skip-whitespace-and-comments
#f
read-one_0
in_0
config_0)))
(call-with-values
(lambda () (port-next-location* in_0 dot-c_0))
(case-lambda
((dot-line_0 dot-col_0 dot-pos_0)
(let ((dot-ec_0 (effective-char dot-c_0 config_0)))
(begin
(if (if (eqv? dot-ec_0 '#\x2e)
(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
0
'special
source_0)))
(if (eq? c_1 'special)
(special1.1 'special)
c_1))))
(begin-unsafe
(readtable-char-delimiter?
(begin-unsafe
(read-config/inner-readtable
(read-config/outer-inner
config_0)))
c_1
config_0))))
#f)
(void)
(let ((temp70_0
(reading-at
config_0
dot-line_0
dot-col_0
dot-pos_0)))
(let ((temp72_0
"expected ~a and value for hash"))
(let ((temp73_0 (begin-unsafe "`.`")))
(let ((temp72_1 temp72_0)
(temp70_1 temp70_0))
(reader-error.1
unsafe-undefined
dot-c_0
#f
unsafe-undefined
in_0
temp70_1
temp72_1
(list temp73_0)))))))
(let ((v_0
(|#%app|
read-one_0
#f
in_0
elem-config_0)))
(let ((closer-c_0
(read-char/skip-whitespace-and-comments
#f
read-one_0
in_0
config_0)))
(call-with-values
(lambda ()
(port-next-location* in_0 closer-c_0))
(case-lambda
((closer-line_0 closer-col_0 closer-pos_0)
(let ((closer-ec_0
(effective-char
closer-c_0
config_0)))
(begin
(if (eqv? closer-ec_0 closer_0)
(void)
(let ((temp75_0
(reading-at
config_0
closer-line_0
closer-col_0
closer-pos_0)))
(let ((temp77_0
"expected ~a after value within a hash"))
(let ((temp78_0
(begin-unsafe
(effective-char-names
closer_0
config_0
"closer"))))
(let ((temp77_1 temp77_0)
(temp75_1 temp75_0))
(reader-error.1
unsafe-undefined
closer-c_0
#f
unsafe-undefined
in_0
temp75_1
temp77_1
(list temp78_0)))))))
(cons
(coerce-key k_0 elem-config_0)
v_0))))
(args
(raise-binding-result-arity-error
3
args)))))))))
(args
(raise-binding-result-arity-error 3 args)))))))))))
(args (raise-binding-result-arity-error 3 args))))))))
(define read-string.1
(|#%name|
read-string
(lambda (mode1_0 in3_0 config4_0)
(begin
(let ((source_0
(begin-unsafe
(read-config/inner-source
(read-config/outer-inner config4_0)))))
(call-with-values
(lambda () (port-next-location in3_0))
(case-lambda
((open-end-line_0 open-end-col_0 open-end-pos_0)
(let ((accum-str_0 (accum-string-init! config4_0)))
(let ((bad-end_0
(|#%name|
bad-end
(lambda (c_0)
(begin
(if (eof-object? c_0)
(let ((temp10_0 "expected a closing `\"`"))
(reader-error.1
unsafe-undefined
c_0
open-end-pos_0
unsafe-undefined
in3_0
config4_0
temp10_0
(list)))
(let ((temp14_0
"found non-character while reading a ~a"))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in3_0
config4_0
temp14_0
(list mode1_0)))))))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((c_0
(read-char-or-special
in3_0
special1.1
source_0)))
(if (not (char? c_0))
(bad-end_0 c_0)
(if (char=? '#\x5c c_0)
(let ((escaped-c_0
(read-char-or-special
in3_0
special1.1
source_0)))
(begin
(if (not (char? escaped-c_0))
(bad-end_0 escaped-c_0)
(void))
(let ((unknown-error_0
(|#%name|
unknown-error
(lambda ()
(begin
(let ((temp18_0
"unknown escape sequence `~a~a` in ~a"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in3_0
config4_0
temp18_0
(list
c_0
escaped-c_0
mode1_0))))))))
(begin
(let ((index_0
(if (char? escaped-c_0)
(let ((codepoint_0
(char->integer
escaped-c_0)))
(if (if (unsafe-fx>=
codepoint_0
10)
(unsafe-fx<
codepoint_0
121)
#f)
(let ((tbl_0
'#(10
0
0
11
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
1
0
0
0
0
1
0
0
0
0
0
0
0
0
12
12
12
12
12
12
12
12
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
15
0
0
0
0
0
0
1
0
0
0
0
2
3
0
0
9
7
0
0
0
0
0
0
0
5
0
0
0
8
0
4
14
6
0
13)))
(unsafe-vector*-ref
tbl_0
(unsafe-fx-
codepoint_0
10)))
0))
0)))
(if (unsafe-fx< index_0 7)
(if (unsafe-fx< index_0 3)
(if (unsafe-fx< index_0 1)
(unknown-error_0)
(if (unsafe-fx< index_0 2)
(accum-string-add!
accum-str_0
escaped-c_0)
(accum-string-add!
accum-str_0
'#\x7)))
(if (unsafe-fx< index_0 4)
(accum-string-add!
accum-str_0
'#\x8)
(if (unsafe-fx< index_0 5)
(accum-string-add!
accum-str_0
'#\x9)
(if (unsafe-fx< index_0 6)
(accum-string-add!
accum-str_0
'#\xa)
(accum-string-add!
accum-str_0
'#\xb)))))
(if (unsafe-fx< index_0 11)
(if (unsafe-fx< index_0 8)
(accum-string-add!
accum-str_0
'#\xc)
(if (unsafe-fx< index_0 9)
(accum-string-add!
accum-str_0
'#\xd)
(if (unsafe-fx< index_0 10)
(accum-string-add!
accum-str_0
'#\x1b)
(void))))
(if (unsafe-fx< index_0 13)
(if (unsafe-fx< index_0 12)
(let ((maybe-newline-c_0
(let ((c_1
(peek-char-or-special
in3_0
0
'special
source_0)))
(if (eq?
c_1
'special)
(special1.1
'special)
c_1))))
(begin
(if (eqv?
maybe-newline-c_0
'#\xa)
(begin-unsafe
(begin
(read-char in3_0)
(void)))
(void))
(void)))
(let ((pos_0
(begin-unsafe
(accum-string-pos
accum-str_0))))
(begin
(accum-string-add!
accum-str_0
escaped-c_0)
(let ((init-v_0
(digit->number
escaped-c_0)))
(let ((v_0
(read-digits.1
8
init-v_0
2
init-v_0
in3_0
config4_0
accum-str_0)))
(begin
(if (<= v_0 255)
(void)
(let ((temp31_0
"escape sequence `~a~a` is out of range in ~a"))
(let ((temp33_0
(accum-string-get!.1
pos_0
accum-str_0
config4_0)))
(let ((temp31_1
temp31_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in3_0
config4_0
temp31_1
(list
c_0
temp33_0
mode1_0))))))
(begin-unsafe
(set-accum-string-pos!
accum-str_0
pos_0))
(accum-string-add!
accum-str_0
(integer->char
v_0))))))))
(if (unsafe-fx< index_0 14)
(let ((pos_0
(begin-unsafe
(accum-string-pos
accum-str_0))))
(let ((v_0
(read-digits.1
16
0
2
#f
in3_0
config4_0
accum-str_0)))
(begin
(if (integer? v_0)
(void)
(no-hex-digits
in3_0
config4_0
v_0
c_0
escaped-c_0))
(begin-unsafe
(set-accum-string-pos!
accum-str_0
pos_0))
(accum-string-add!
accum-str_0
(integer->char
v_0)))))
(if (unsafe-fx< index_0 15)
(begin
(if (eq? mode1_0 'string)
(void)
(unknown-error_0))
(let ((pos_0
(begin-unsafe
(accum-string-pos
accum-str_0))))
(let ((v_0
(read-digits.1
16
0
4
#f
in3_0
config4_0
accum-str_0)))
(begin
(if (integer? v_0)
(void)
(no-hex-digits
in3_0
config4_0
v_0
c_0
escaped-c_0))
(if (let ((or-part_0
(<
v_0
55296)))
(if or-part_0
or-part_0
(>
v_0
57343)))
(begin
(begin-unsafe
(set-accum-string-pos!
accum-str_0
pos_0))
(accum-string-add!
accum-str_0
(integer->char
v_0)))
(let ((next!_0
(|#%name|
next!
(lambda ()
(begin
(let ((next-c_0
(read-char-or-special
in3_0
special1.1
source_0)))
(begin
(if (char?
next-c_0)
(accum-string-add!
accum-str_0
next-c_0)
(void))
next-c_0)))))))
(let ((v2_0
(let ((next-c_0
(next!_0)))
(if (char=?
next-c_0
'#\x5c)
(let ((next-c_1
(next!_0)))
(if (char=?
next-c_1
'#\x75)
(let ((v2_0
(read-digits.1
16
0
4
#f
in3_0
config4_0
accum-str_0)))
(if (integer?
v2_0)
(if (>=
v2_0
56320)
(if (<=
v2_0
57343)
v2_0
#f)
#f)
v2_0))
next-c_1))
next-c_0))))
(if (integer?
v2_0)
(let ((combined-v_0
(let ((app_0
(arithmetic-shift
(-
v_0
55296)
10)))
(+
app_0
(-
v2_0
56320)
65536))))
(if (>
combined-v_0
1114111)
(let ((temp55_0
"escape sequence `~au~a` is out of range in string"))
(let ((temp57_0
(accum-string-get!.1
pos_0
accum-str_0
config4_0)))
(let ((temp55_1
temp55_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in3_0
config4_0
temp55_1
(list
c_0
temp57_0)))))
(begin
(begin-unsafe
(set-accum-string-pos!
accum-str_0
pos_0))
(accum-string-add!
accum-str_0
(integer->char
combined-v_0)))))
(let ((temp64_0
"bad or incomplete surrogate-style encoding at `~au~a`"))
(let ((temp66_0
(accum-string-get!.1
pos_0
accum-str_0
config4_0)))
(let ((temp64_1
temp64_0))
(reader-error.1
unsafe-undefined
v2_0
#f
unsafe-undefined
in3_0
config4_0
temp64_1
(list
c_0
temp66_0)))))))))))))
(begin
(if (eq? mode1_0 'string)
(void)
(unknown-error_0))
(let ((pos_0
(begin-unsafe
(accum-string-pos
accum-str_0))))
(let ((v_0
(read-digits.1
16
0
8
#f
in3_0
config4_0
accum-str_0)))
(begin
(if (integer? v_0)
(void)
(no-hex-digits
in3_0
config4_0
v_0
c_0
escaped-c_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-accum-string-pos!
accum-str_0
pos_0))
(accum-string-add!
accum-str_0
(integer->char
v_0)))
(let ((temp77_0
"escape sequence `~aU~a` is out of range in string"))
(let ((temp79_0
(accum-string-get!.1
pos_0
accum-str_0
config4_0)))
(let ((temp77_1
temp77_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in3_0
config4_0
temp77_1
(list
c_0
temp79_0))))))))))))))))
(loop_0)))))
(if (char=? '#\x22 c_0)
null
(begin
(if (eq? mode1_0 '|byte string|)
(if (byte? (char->integer c_0))
(void)
(let ((temp85_0
"character `~a` is out of range in byte string"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in3_0
config4_0
temp85_0
(list c_0))))
(void))
(accum-string-add! accum-str_0 c_0)
(loop_0)))))))))))
(loop_0))
(let ((str_0
(if (eq? mode1_0 '|byte string|)
(accum-string-get-bytes!.1 0 accum-str_0 config4_0)
(accum-string-get!.1 0 accum-str_0 config4_0))))
(wrap str_0 in3_0 config4_0 str_0))))))
(args (raise-binding-result-arity-error 3 args)))))))))
(define read-here-string
(lambda (in_0 config_0)
(let ((source_0
(begin-unsafe
(read-config/inner-source (read-config/outer-inner 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 ((accum-str_0 (accum-string-init! config_0)))
(let ((full-terminator_0
(cons
'#\xa
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(let ((c_0
(read-char-or-special
in_0
special1.1
source_0)))
(if (eof-object? c_0)
(let ((temp94_0
"found end-of-file after `#<<` and before a newline"))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in_0
config_0
temp94_0
(list)))
(if (not (char? c_0))
(let ((temp98_0
"found non-character while reading `#<<`"))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in_0
config_0
temp98_0
(list)))
(if (char=? c_0 '#\xa)
null
(cons c_0 (loop_0)))))))))))
(loop_0)))))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (terminator_0 terminator-accum_0)
(begin
(let ((c_0
(read-char-or-special in_0 special1.1 source_0)))
(if (eof-object? c_0)
(if (null? terminator_0)
(void)
(let ((temp103_0
"found end-of-file before terminating `~a`"))
(let ((temp104_0
(list->string (cdr full-terminator_0))))
(let ((temp103_1 temp103_0))
(reader-error.1
unsafe-undefined
c_0
open-end-pos_0
unsafe-undefined
in_0
config_0
temp103_1
(list temp104_0))))))
(if (not (char? c_0))
(let ((temp108_0
"found non-character while reading `#<<`"))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in_0
config_0
temp108_0
(list)))
(if (if (pair? terminator_0)
(char=? c_0 (car terminator_0))
#f)
(let ((app_0 (cdr terminator_0)))
(loop_0
app_0
(cons
(car terminator_0)
terminator-accum_0)))
(if (if (null? terminator_0)
(char=? c_0 '#\xa)
#f)
(void)
(begin
(if (null? terminator-accum_0)
(void)
(begin
(let ((lst_0
(reverse$1 terminator-accum_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((c_1
(unsafe-car
lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(begin
(accum-string-add!
accum-str_0
c_1)
(for-loop_0
rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)))
(if (char=? c_0 '#\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
full-terminator_0
null))))))))))))))
(loop_0 (cdr full-terminator_0) null))
(let ((str_0 (accum-string-get!.1 0 accum-str_0 config_0)))
(wrap str_0 in_0 config_0 str_0))))))
(args (raise-binding-result-arity-error 3 args)))))))
(define no-hex-digits
(lambda (in_0 config_0 c_0 escaping-c_0 escaped-c_0)
(let ((temp114_0 "no hex digit following `~a~a`"))
(reader-error.1
unsafe-undefined
c_0
#f
unsafe-undefined
in_0
config_0
temp114_0
(list escaping-c_0 escaped-c_0)))))
(define read-character
(lambda (in_0 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 ((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 `#\\`"))
(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
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!
(begin-unsafe
(read-config/inner-st
(read-config/outer-inner config_0)))
accum-str_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
(accum-string-add! accum-str_0 c_0)
(begin
(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
"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?
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)))
(call-with-values
(lambda () (port-next-location in_0))
(case-lambda
((end-line_0 end-col_0 end-pos_0)
(let ((e_0 (|#%app| read-one_0 #f in_0 config_0)))
(begin
(if (eof-object? e_0)
(let ((temp5_0 "expected an element for ~a, found end-of-file"))
(reader-error.1
unsafe-undefined
e_0
end-pos_0
unsafe-undefined
in_0
config_0
temp5_0
(list desc_0)))
(void))
(wrap (list wrapped-sym_0 e_0) in_0 config_0 #f))))
(args (raise-binding-result-arity-error 3 args)))))))
(define read-delimited-constant
(lambda (init-c_0 can-match?_0 chars_0 val_0 in_0 config_0)
(let ((accum-str_0 (accum-string-init! config_0)))
(begin
(accum-string-add! accum-str_0 init-c_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (chars_1)
(begin
(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
(accum-string-get!.1
0
accum-str_0
config_0)))
(let ((temp10_1 temp10_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
config_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
in_0
config_0
(accum-string-get!.1 0 accum-str_0 config_0))))))
(define read-box
(lambda (read-one_0 dispatch-c_0 in_0 config_0)
(begin
(if (check-parameter 1/read-accept-box config_0)
(void)
(let ((temp3_0 "`~a&` forms not enabled"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
config_0
temp3_0
(list dispatch-c_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 ((e_0 (|#%app| read-one_0 #f in_0 (next-readtable config_0))))
(begin
(if (eof-object? e_0)
(let ((temp9_0
"expected an element for `~a&` box, found end-of-file"))
(reader-error.1
unsafe-undefined
e_0
open-end-pos_0
unsafe-undefined
in_0
config_0
temp9_0
(list dispatch-c_0)))
(void))
(wrap
(if (begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config_0)))
(box-immutable e_0)
(box e_0))
in_0
config_0
#f))))
(args (raise-binding-result-arity-error 3 args)))))))
(define read-regexp
(lambda (mode-c_0 accum-str_0 in_0 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)))
(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)
(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
(read-extension-prefix
(cons dispatch-c_0 '(#\x72 #\x65))
'(#\x61 #\x64 #\x65 #\x72)
in_0
config_0)))
(begin
(if (check-parameter 1/read-accept-reader config_0)
(void)
(let ((temp48_0 "`~a` not enabled"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
config_0
temp48_0
(list extend-str_0))))
(let ((mod-path-wrapped_0
(|#%app| read-one_0 #f in_0 (next-readtable config_0))))
(begin
(if (eof-object? mod-path-wrapped_0)
(let ((temp53_0
"expected a datum after `~a`, found end-of-file"))
(reader-error.1
unsafe-undefined
mod-path-wrapped_0
#f
unsafe-undefined
in_0
config_0
temp53_0
(list extend-str_0)))
(void))
(let ((temp41_0
(|#%app|
(begin-unsafe
(read-config/inner-coerce
(read-config/outer-inner config_0)))
#f
mod-path-wrapped_0
#f)))
(read-extension.1
#f
mod-path-wrapped_0
#f
'|#reader|
temp41_0
read-recur_0
in_0
config_0))))))))
(define read-extension-lang.1
(|#%name|
read-extension-lang
(lambda (get-info?1_0 read-recur3_0 dispatch-c4_0 in5_0 config6_0)
(begin
(let ((extend-str_0
(read-extension-prefix
(cons dispatch-c4_0 '(#\x6c))
'(#\x61 #\x6e #\x67)
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 ((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
(lambda (get-info?17_0
init-c15_0
one-space?16_0
who18_0
extend-str23_0
read-recur24_0
in25_0
config26_0)
(begin
(begin
(if (if (check-parameter 1/read-accept-reader config26_0)
(check-parameter 1/read-accept-lang config26_0)
#f)
(void)
(let ((temp85_0 "`~a` not enabled\n possible reason: ~a"))
(let ((temp87_0
(string-append
"not allowed again inside a module that already starts `#lang`,"
" or not enabled for interactive evaluation")))
(let ((temp85_1 temp85_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in25_0
config26_0
temp85_1
(list extend-str23_0 temp87_0))))))
(call-with-values
(lambda () (port-next-location in25_0))
(case-lambda
((line_0 col_0 pos_0)
(let ((accum-str_0 (accum-string-init! config26_0)))
(begin
(if init-c15_0
(accum-string-add! accum-str_0 init-c15_0)
(void))
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda ()
(begin
(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
0
'special
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`"))
(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)))
(begin
(if (equal? lang-str_0 "")
(let ((temp106_0
"expected a non-empty sequence of alphanumeric, `-`, `+`, `_`, or `/` after `~a~a`"))
(let ((temp108_0 (if one-space?16_0 " " "")))
(let ((temp106_1 temp106_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in25_0
config26_0
temp106_1
(list extend-str23_0 temp108_0)))))
(void))
(begin
(if (char=? '#\x2f (string-ref lang-str_0 0))
(let ((temp111_0
"expected a name that does not start `/` after `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in25_0
config26_0
temp111_0
(list extend-str23_0)))
(void))
(begin
(if (char=?
'#\x2f
(string-ref
lang-str_0
(sub1 (string-length lang-str_0))))
(let ((temp115_0
"expected a name that does not end `/` after `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in25_0
config26_0
temp115_0
(list extend-str23_0)))
(void))
(let ((submod-path_0
(list*
'submod
(string->symbol lang-str_0)
'(reader))))
(let ((reader-path_0
(string->symbol
(string-append
lang-str_0
"/lang/reader"))))
(let ((temp80_0
(reading-at
config26_0
line_0
col_0
pos_0)))
(read-extension.1
get-info?17_0
unsafe-undefined
submod-path_0
who18_0
reader-path_0
read-recur24_0
in25_0
temp80_0))))))))))))
(args (raise-binding-result-arity-error 3 args)))))))))
(define char-lang-nonsep?
(lambda (c_0)
(if (< (char->integer c_0) 128)
(let ((or-part_0 (char-alphabetic? c_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (char-numeric? c_0)))
(if or-part_1
or-part_1
(let ((or-part_2 (char=? '#\x2d c_0)))
(if or-part_2
or-part_2
(let ((or-part_3 (char=? '#\x2b c_0)))
(if or-part_3 or-part_3 (char=? '#\x5f c_0)))))))))
#f)))
(define read-extension-prefix
(lambda (already_0 wanted_0 in_0 config_0)
(let ((accum-str_0 (accum-string-init! config_0)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((c_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(accum-string-add! accum-str_0 c_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 already_0)))
(void)
(letrec*
((loop_0
(|#%name|
loop
(lambda (wanted_1)
(begin
(if (null? wanted_1)
(void)
(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
(|#%name|
read-extension
(lambda (get-info?30_0
mod-path-wrapped29_0
try-first-mod-path28_0
who31_0
mod-path-datum36_0
read-recur37_0
in38_0
config39_0)
(begin
(let ((mod-path-wrapped_0
(if (eq? mod-path-wrapped29_0 unsafe-undefined)
(|#%app|
(begin-unsafe
(read-config/inner-coerce
(read-config/outer-inner config39_0)))
#t
mod-path-datum36_0
(port+config->srcloc.1 #f in38_0 config39_0))
mod-path-wrapped29_0)))
(begin
(force-parameters! config39_0)
(let ((guard_0 (1/current-reader-guard)))
(let ((mod-path_0
(let ((or-part_0
(if try-first-mod-path28_0
(let ((mod-path_0
(|#%app| guard_0 try-first-mod-path28_0)))
(if (|#%app|
(begin-unsafe
(read-config/inner-module-declared?
(read-config/outer-inner config39_0)))
try-first-mod-path28_0)
mod-path_0
#f))
#f)))
(if or-part_0
or-part_0
(|#%app| guard_0 mod-path-datum36_0)))))
(|#%app|
(begin-unsafe
(read-config/inner-call-with-root-namespace
(read-config/outer-inner config39_0)))
(lambda ()
(let ((for-syntax?_0
(begin-unsafe
(read-config/inner-for-syntax?
(read-config/outer-inner config39_0)))))
(let ((dynamic-require_0
(begin-unsafe
(read-config/inner-dynamic-require
(read-config/outer-inner config39_0)))))
(let ((no-value_0 (gensym)))
(let ((extension_0
(if get-info?30_0
(|#%app|
dynamic-require_0
mod-path_0
'get-info
(lambda () no-value_0))
(|#%app|
dynamic-require_0
mod-path_0
(if for-syntax?_0 'read-syntax 'read)))))
(if (eq? extension_0 no-value_0)
#f
(let ((result-v_0
(if (if for-syntax?_0
(not get-info?30_0)
#f)
(if (procedure-arity-includes?
extension_0
6)
(with-continuation-mark*
push-authentic
current-read-config
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)
(with-continuation-mark*
push-authentic
current-read-config
config39_0
(|#%app|
extension_0
(begin-unsafe
(read-config/inner-source
(read-config/outer-inner
config39_0)))
in38_0))
(raise-argument-error
who31_0
"(or/c (procedure-arity-includes?/c 2) (procedure-arity-includes?/c 6))"
extension_0)))
(if (procedure-arity-includes?
extension_0
5)
(with-continuation-mark*
push-authentic
current-read-config
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
"(procedure-arity-includes?/c 5)"
extension_0)
(if (procedure-arity-includes?
extension_0
1)
(with-continuation-mark*
push-authentic
current-read-config
config39_0
(|#%app| extension_0 in38_0))
(raise-argument-error
who31_0
"(or/c (procedure-arity-includes?/c 1) (procedure-arity-includes?/c 5))"
extension_0)))))))
(if get-info?30_0
(begin
(if (if (procedure? result-v_0)
(procedure-arity-includes?
result-v_0
2)
#f)
(void)
(raise-result-error
'read-language
"(procedure-arity-includes?/c 2)"
result-v_0))
result-v_0)
(if (1/special-comment? result-v_0)
(|#%app| read-recur37_0 #f in38_0 config39_0)
(coerce
result-v_0
in38_0
config39_0)))))))))))))))))))
(define read-language/get-info
(lambda (read-one_0 in_0 config_0 fail-k_0)
(let ((c_0
(read-char/skip-whitespace-and-comments
#f
read-one_0
in_0
config_0)))
(call-with-values
(lambda () (port-next-location* in_0 c_0))
(case-lambda
((line_0 col_0 pos_0)
(let ((l-config_0
(override-parameter
1/read-accept-reader
(reading-at config_0 line_0 col_0 pos_0)
#t)))
(if (not (eqv? c_0 '#\x23))
(if fail-k_0
(|#%app| fail-k_0)
(lang-error in_0 l-config_0 "" c_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)
(let ((add-prefix_0
(|#%name|
add-prefix
(lambda (s_0)
(begin
(if (string=? prefix_0 "")
(format "`~a` followed by ~a" prefix_0 s_0)
s_0))))))
(let ((temp15_0
(string-append
"expected (after whitespace and comments) `#lang ` or `#!` followed"
" immediately by a language name, found ~a")))
(let ((temp16_0
(if (eof-object? c_0)
(add-prefix_0 "end-of-file")
(if (not (char? c_0))
(add-prefix_0 "non-character")
(format "`~a~a`" prefix_0 c_0)))))
(let ((temp15_1 temp15_0))
(reader-error.1
unsafe-undefined
c_0
#f
'read-language
in_0
config_0
temp15_1
(list temp16_0))))))))
(define read.1
(|#%name|
read
(lambda (call-with-root-namespace10_0
coerce13_0
coerce-key14_0
dynamic-require11_0
for-syntax?8_0
init-c2_0
keep-comment?15_0
local-graph?6_0
module-declared?12_0
next-readtable3_0
read-compiled9_0
readtable4_0
recursive?5_0
source7_0
wrap1_0
in31_0)
(begin
(let ((next-readtable_0
(if (eq? next-readtable3_0 unsafe-undefined)
(1/current-readtable)
next-readtable3_0)))
(let ((readtable_0
(if (eq? readtable4_0 unsafe-undefined)
next-readtable_0
readtable4_0)))
(let ((keep-comment?_0
(if (eq? keep-comment?15_0 unsafe-undefined)
recursive?5_0
keep-comment?15_0)))
(let ((config_0
(let ((c1_0 (if recursive?5_0 (current-read-config) #f)))
(if c1_0
(read-config-update.1
for-syntax?8_0
keep-comment?_0
next-readtable_0
readtable_0
local-graph?6_0
wrap1_0
c1_0)
(make-read-config.1
call-with-root-namespace10_0
coerce13_0
coerce-key14_0
dynamic-require11_0
for-syntax?8_0
keep-comment?_0
module-declared?12_0
next-readtable_0
read-compiled9_0
readtable_0
source7_0
wrap1_0)))))
(let ((v_0 (read-one init-c2_0 in31_0 config_0)))
(if (if (let ((or-part_0 (not recursive?5_0)))
(if or-part_0 or-part_0 local-graph?6_0))
(read-config-state-graph
(begin-unsafe
(read-config/inner-st
(read-config/outer-inner config_0))))
#f)
(catch-and-reraise-as-reader/proc
#f
config_0
(lambda () (make-reader-graph v_0)))
(if (if recursive?5_0
(if (not local-graph?6_0)
(if (not for-syntax?8_0)
(if (not (eof-object? v_0))
(not (1/special-comment? v_0))
#f)
#f)
#f)
#f)
(begin (get-graph-hash config_0) v_0)
v_0)))))))))))
(define read-language.1
(|#%name|
read-language
(lambda (call-with-root-namespace37_0
coerce39_0
coerce-key40_0
dynamic-require36_0
for-syntax?33_0
module-declared?38_0
read-compiled35_0
wrap34_0
in49_0
fail-k50_0)
(begin
(let ((config_0
(make-read-config.1
call-with-root-namespace37_0
coerce39_0
coerce-key40_0
dynamic-require36_0
for-syntax?33_0
#f
module-declared?38_0
#f
read-compiled35_0
#f
#f
wrap34_0)))
(let ((l-config_0
(override-parameter 1/read-accept-reader config_0 #f)))
(read-language/get-info
read-undotted
in49_0
config_0
fail-k50_0)))))))
(define read-one
(lambda (init-c_0 in_0 config_0)
(if (not (check-parameter 1/read-cdot config_0))
(read-undotted init-c_0 in_0 config_0)
(if (check-parameter 1/read-cdot config_0)
(call-with-values
(lambda () (port-next-location in_0))
(case-lambda
((line_0 col_0 pos_0)
(let ((v_0 (read-undotted init-c_0 in_0 config_0)))
(if (1/special-comment? v_0)
v_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (v_1)
(begin
(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))))
(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
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)))))
(define read-undotted
(lambda (init-c_0 in_0 config_0)
(let ((c_0
(read-char/skip-whitespace-and-comments
init-c_0
read-one
in_0
config_0)))
(call-with-values
(lambda () (port-next-location* in_0 c_0))
(case-lambda
((line_0 col_0 pos_0)
(if (eof-object? c_0)
eof
(if (not (char? c_0))
(let ((v_0 (special-value c_0)))
(if (1/special-comment? v_0)
(if (begin-unsafe (read-config/outer-keep-comment? config_0))
v_0
(read-undotted #f in_0 config_0))
(coerce v_0 in_0 (reading-at config_0 line_0 col_0 pos_0))))
(let ((c2_0 (readtable-handler config_0 c_0)))
(if c2_0
(let ((v_0
(readtable-apply
c2_0
c_0
in_0
config_0
line_0
col_0
pos_0)))
(retry-special-comment v_0 in_0 config_0))
(let ((ec_0 (effective-char c_0 config_0)))
(begin
(if (not (char-closer? ec_0 config_0))
(track-indentation! config_0 line_0 col_0)
(void))
(let ((r-config_0
(reading-at
(discard-comment config_0)
line_0
col_0
pos_0)))
(let ((index_0
(if (char? ec_0)
(let ((codepoint_0 (char->integer ec_0)))
(if (if (unsafe-fx>= codepoint_0 34)
(unsafe-fx< codepoint_0 126)
#f)
(if (unsafe-fx< codepoint_0 91)
(if (unsafe-fx< codepoint_0 40)
(let ((tbl_0 '#(11 1 0 0 0 2)))
(unsafe-vector*-ref
tbl_0
(unsafe-fx- codepoint_0 34)))
(if (unsafe-fx< codepoint_0 42)
(let ((tbl_0 '#(5 6)))
(unsafe-vector*-ref
tbl_0
(unsafe-fx- codepoint_0 40)))
(if (unsafe-fx< codepoint_0 44)
0
(if (unsafe-fx< codepoint_0 45)
4
0))))
(let ((tbl_0
'#(7
0
8
0
0
3
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
0
9
12
10)))
(unsafe-vector*-ref
tbl_0
(unsafe-fx- codepoint_0 91))))
0))
0)))
(if (unsafe-fx< index_0 6)
(if (unsafe-fx< index_0 2)
(if (unsafe-fx< index_0 1)
(let ((v_0
(let ((temp88_0
(if (let ((or-part_0
(eq? c_0 ec_0)))
(if or-part_0
or-part_0
(if (<
(char->integer ec_0)
128)
(char-numeric? ec_0)
#f)))
'symbol-or-number
'symbol/indirect)))
(read-symbol-or-number.1
#f
temp88_0
c_0
in_0
r-config_0))))
(retry-special-comment v_0 in_0 config_0))
(read-dispatch c_0 in_0 r-config_0 config_0))
(if (unsafe-fx< index_0 3)
(read-quote
read-one
'quote
"quoting \"'\""
c_0
in_0
r-config_0)
(if (unsafe-fx< index_0 4)
(if (check-parameter
1/read-accept-quasiquote
config_0)
(read-quote
read-one
'quasiquote
"quasiquoting \"`\""
c_0
in_0
r-config_0)
(let ((temp91_0 "illegal use of `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp91_0
(list c_0))))
(if (unsafe-fx< index_0 5)
(if (check-parameter
1/read-accept-quasiquote
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
0
'special
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)))
(read-quote
read-one
'unquote-splicing
"unquoting `,@`"
c_0
in_0
r-config_0))
(read-quote
read-one
'unquote
"unquoting `,`"
c_0
in_0
r-config_0))))
(let ((temp95_0 "illegal use of `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp95_0
(list c_0))))
(wrap
(read-unwrapped-sequence.1
'all
unsafe-undefined
unsafe-undefined
#t
unsafe-undefined
read-one
ec_0
'#\x28
'#\x29
in_0
r-config_0)
in_0
r-config_0
ec_0)))))
(if (unsafe-fx< index_0 9)
(if (unsafe-fx< index_0 7)
(let ((temp106_0 "~a"))
(let ((temp107_0
(indentation-unexpected-closer-message
ec_0
c_0
r-config_0)))
(let ((temp106_1 temp106_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp106_1
(list temp107_0)))))
(if (unsafe-fx< index_0 8)
(if (let ((or-part_0
(check-parameter
1/read-square-bracket-as-paren
config_0)))
(if or-part_0
or-part_0
(check-parameter
1/read-square-bracket-with-tag
config_0)))
(wrap
(read-unwrapped-sequence.1
'all
unsafe-undefined
unsafe-undefined
#t
unsafe-undefined
read-one
ec_0
'#\x5b
'#\x5d
in_0
r-config_0)
in_0
r-config_0
ec_0)
(let ((temp117_0 "illegal use of `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp117_0
(list c_0))))
(if (let ((or-part_0
(check-parameter
1/read-square-bracket-as-paren
config_0)))
(if or-part_0
or-part_0
(check-parameter
1/read-square-bracket-with-tag
config_0)))
(let ((temp121_0 "~a"))
(let ((temp122_0
(indentation-unexpected-closer-message
ec_0
c_0
r-config_0)))
(let ((temp121_1 temp121_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp121_1
(list temp122_0)))))
(let ((temp125_0 "illegal use of `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp125_0
(list c_0))))))
(if (unsafe-fx< index_0 10)
(if (let ((or-part_0
(check-parameter
1/read-curly-brace-as-paren
config_0)))
(if or-part_0
or-part_0
(check-parameter
1/read-curly-brace-with-tag
config_0)))
(wrap
(read-unwrapped-sequence.1
'all
unsafe-undefined
unsafe-undefined
#t
unsafe-undefined
read-one
ec_0
'#\x7b
'#\x7d
in_0
r-config_0)
in_0
r-config_0
ec_0)
(let ((temp136_0 "illegal use of `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp136_0
(list c_0))))
(if (unsafe-fx< index_0 11)
(if (let ((or-part_0
(check-parameter
1/read-curly-brace-as-paren
config_0)))
(if or-part_0
or-part_0
(check-parameter
1/read-curly-brace-with-tag
config_0)))
(let ((temp140_0 "~a"))
(let ((temp141_0
(indentation-unexpected-closer-message
ec_0
c_0
r-config_0)))
(let ((temp140_1 temp140_0))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp140_1
(list temp141_0)))))
(let ((temp144_0 "illegal use of `~a`"))
(reader-error.1
unsafe-undefined
'#\x78
#f
unsafe-undefined
in_0
r-config_0
temp144_0
(list c_0))))
(if (unsafe-fx< index_0 12)
(read-string.1 'string in_0 r-config_0)
(read-symbol-or-number.1
#f
'symbol
c_0
in_0
r-config_0)))))))))))))))
(args (raise-binding-result-arity-error 3 args)))))))
(define read-dispatch
(lambda (dispatch-c_0 in_0 config_0 orig-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)))
(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`"))
(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
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
#f
'any
read-one
'#\x5b
'#\x5b
'#\x5d
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
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
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
#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 ((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 (unsafe-fx< index_0 35)
(|read-extension-#!.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)
in_0
config_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)
(if (begin-unsafe (read-config/outer-keep-comment? config_0))
v_0
(read-undotted #f in_0 config_0))
v_0)))
(define 1/module-declared?
(let ((module-declared?_0
(|#%name|
module-declared?
(lambda (mod2_0 load?1_0)
(begin
(begin
(if (module-reference? mod2_0)
(void)
(raise-argument-error
'module-declared?
module-reference-str
mod2_0))
(let ((ns_0 (1/current-namespace)))
(let ((name_0
(reference->resolved-module-path.1 load?1_0 mod2_0)))
(if (namespace->module ns_0 name_0) #t #f)))))))))
(|#%name|
module-declared?
(case-lambda
((mod_0) (begin (module-declared?_0 mod_0 #f)))
((mod_0 load?1_0) (module-declared?_0 mod_0 load?1_0))))))
(define 1/module-predefined?
(|#%name|
module-predefined?
(lambda (mod_0)
(begin
(begin
(if (module-reference? mod_0)
(void)
(raise-argument-error
'module-predefined?
module-reference-str
mod_0))
(let ((ns_0 (1/current-namespace)))
(let ((name_0 (reference->resolved-module-path.1 #f mod_0)))
(let ((m_0 (namespace->module ns_0 name_0)))
(if m_0 (module-is-predefined? m_0) #f)))))))))
(define module->.1
(|#%name|
module->
(lambda (extra-checks3_0 extract6_0 who7_0 mod8_0 load?5_0)
(begin
(begin
(if (module-reference? mod8_0)
(void)
(raise-argument-error who7_0 module-reference-str mod8_0))
(begin
(|#%app| extra-checks3_0)
(let ((m_0
(let ((app_0 (1/current-namespace)))
(namespace->module/complain
who7_0
app_0
(reference->resolved-module-path.1 load?5_0 mod8_0)))))
(|#%app| extract6_0 m_0))))))))
(define 1/module->language-info
(let ((module->language-info_0
(|#%name|
module->language-info
(lambda (mod11_0 load?10_0)
(begin
(module->.1
void
module-language-info
'module->language-info
mod11_0
load?10_0))))))
(|#%name|
module->language-info
(case-lambda
((mod_0) (begin (module->language-info_0 mod_0 #f)))
((mod_0 load?10_0) (module->language-info_0 mod_0 load?10_0))))))
(define 1/module->imports
(|#%name|
module->imports
(lambda (mod_0)
(begin (module->.1 void module-requires 'module->imports mod_0 #f)))))
(define 1/module->exports
(let ((module->exports_0
(|#%name|
module->exports
(lambda (mod13_0 verbosity12_0)
(begin
(call-with-values
(lambda ()
(let ((temp41_0
(|#%name|
temp41
(lambda (m_0)
(begin
(values
(module-provides m_0)
(module-self m_0)))))))
(let ((temp44_0
(lambda ()
(check-provides-verbosity
'module->exports
verbosity12_0))))
(module->.1
temp44_0
temp41_0
'module->exports
mod13_0
#f))))
(case-lambda
((provides_0 self_0)
(provides->api-provides provides_0 self_0 verbosity12_0))
(args (raise-binding-result-arity-error 2 args)))))))))
(|#%name|
module->exports
(case-lambda
((mod_0) (begin (module->exports_0 mod_0 #f)))
((mod_0 verbosity12_0) (module->exports_0 mod_0 verbosity12_0))))))
(define 1/module->indirect-exports
(|#%name|
module->indirect-exports
(lambda (mod_0)
(begin
(let ((temp45_0
(|#%name|
temp45
(lambda (m_0)
(begin
(variables->api-nonprovides
(module-provides m_0)
(|#%app| (module-get-all-variables m_0))))))))
(module->.1 void temp45_0 'module->indirect-exports mod_0 #f))))))
(define 1/module-provide-protected?
(|#%name|
module-provide-protected?
(lambda (mod_0 sym_0)
(begin
(let ((temp48_0
(|#%name|
temp48
(lambda (m_0)
(begin
(let ((b/p_0 (hash-ref (module-provides m_0) sym_0 #f)))
(let ((or-part_0 (not b/p_0)))
(if or-part_0
or-part_0
(provided-as-protected? b/p_0)))))))))
(module->.1 void temp48_0 'module-provide-protected? mod_0 #f))))))
(define 1/module->namespace
(let ((module->namespace_0
(|#%name|
module->namespace
(lambda (mod15_0 ns14_0)
(begin
(let ((ns_0
(if (eq? ns14_0 unsafe-undefined)
(1/current-namespace)
ns14_0)))
(begin
(if (module-reference? mod15_0)
(void)
(raise-argument-error
'module->namespace
module-reference-str
mod15_0))
(begin
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'module->namespace
"namespace?"
ns_0))
(let ((name_0
(reference->resolved-module-path.1 #t mod15_0)))
(let ((phase_0 (namespace-phase ns_0)))
(let ((m-ns_0
(namespace->module-namespace.1
#f
#f
void
ns_0
name_0
phase_0)))
(begin
(if m-ns_0
(void)
(begin
(namespace->module/complain
'module->namespace
ns_0
name_0)
(raise-arguments-error
'module->namespace
"module not instantiated in the current namespace"
"name"
name_0)))
(if (let ((app_0 (current-code-inspector)))
(inspector-superior?
app_0
(namespace-inspector m-ns_0)))
(void)
(raise-arguments-error
'module->namespace
"current code inspector cannot access namespace of module"
"module name"
name_0))
(if (namespace-get-root-expand-ctx m-ns_0)
(void)
(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)))))
(let ((temp53_0 (namespace-mpi m-ns_0)))
(namespace-module-make-available!.1
unsafe-undefined
ns_0
temp53_0
phase_0))
m-ns_0))))))))))))
(|#%name|
module->namespace
(case-lambda
((mod_0) (begin (module->namespace_0 mod_0 unsafe-undefined)))
((mod_0 ns14_0) (module->namespace_0 mod_0 ns14_0))))))
(define 1/namespace-unprotect-module
(let ((namespace-unprotect-module_0
(|#%name|
namespace-unprotect-module
(lambda (insp17_0 mod18_0 ns16_0)
(begin
(let ((ns_0
(if (eq? ns16_0 unsafe-undefined)
(1/current-namespace)
ns16_0)))
(begin
(if (inspector? insp17_0)
(void)
(raise-argument-error
'namespace-unprotect-module
"inspector?"
insp17_0))
(begin
(if (1/module-path? mod18_0)
(void)
(raise-argument-error
'namespace-unprotect-module
"module-path?"
mod18_0))
(begin
(if (1/namespace? ns_0)
(void)
(raise-argument-error
'namespace-unprotect-module
"namespace?"
ns_0))
(let ((name_0
(reference->resolved-module-path.1 #f mod18_0)))
(let ((phase_0 (namespace-phase ns_0)))
(let ((m-ns_0
(namespace->module-namespace.1
#f
#f
void
ns_0
name_0
phase_0)))
(begin
(if m-ns_0
(void)
(raise-arguments-error
'namespace-unprotect-module
"module not instantiated"
"module name"
name_0))
(if (inspector-superior?
insp17_0
(namespace-inspector m-ns_0))
(set-namespace-inspector!
m-ns_0
(make-inspector (current-code-inspector)))
(void)))))))))))))))
(|#%name|
namespace-unprotect-module
(case-lambda
((insp_0 mod_0)
(begin (namespace-unprotect-module_0 insp_0 mod_0 unsafe-undefined)))
((insp_0 mod_0 ns16_0)
(namespace-unprotect-module_0 insp_0 mod_0 ns16_0))))))
(define namespace->module/complain
(lambda (who_0 ns_0 name_0)
(let ((or-part_0 (namespace->module ns_0 name_0)))
(if or-part_0
or-part_0
(raise-arguments-error
who_0
"unknown module in the current namespace"
"name"
name_0)))))
(define module-reference?
(lambda (mod_0)
(let ((or-part_0 (1/module-path? mod_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (1/module-path-index? mod_0)))
(if or-part_1 or-part_1 (1/resolved-module-path? mod_0)))))))
(define module-reference-str
"(or/c module-path? module-path-index? resolved-module-path?)")
(define reference->resolved-module-path.1
(|#%name|
reference->resolved-module-path
(lambda (load?19_0 mod21_0)
(begin
(if (1/resolved-module-path? mod21_0)
mod21_0
(let ((mpi_0
(if (1/module-path-index? mod21_0)
mod21_0
(1/module-path-index-join mod21_0 #f))))
(1/module-path-index-resolve mpi_0 load?19_0)))))))
(define read-linklet-bundle-or-directory
(lambda (in_0)
(letrec*
((read-linklet-or-directory_0
(|#%name|
read-linklet-or-directory
(lambda (initial?_0)
(begin
(let ((start-pos_0 (- (file-position in_0) 2)))
(let ((vers-len_0 (min 63 (read-byte in_0))))
(let ((vers_0 (read-bytes vers-len_0 in_0)))
(begin
(if (equal? vers_0 version-bytes$1)
(void)
(let ((app_0 (bytes->string/utf-8 vers_0 '#\x3f)))
(raise-read-error
'read-compiled-linklet
"version mismatch"
"expected"
(version)
"found"
app_0
"in"
(let ((n_0 (object-name in_0)))
(if (path? n_0)
(unquoted-printing-string (path->string n_0))
in_0)))))
(let ((vm-len_0 (min 63 (read-byte in_0))))
(let ((vm_0 (read-bytes vm-len_0 in_0)))
(let ((as-correlated-linklet?_0
(equal? vm_0 correlated-linklet-vm-bytes)))
(begin
(if (if as-correlated-linklet?_0
as-correlated-linklet?_0
(equal? vm_0 vm-bytes$1))
(void)
(let ((app_0 (bytes->string/utf-8 vm-bytes$1)))
(let ((app_1
(bytes->string/utf-8 vm_0 '#\x3f)))
(raise-read-error
'read-compiled-linklet
"virtual-machine mismatch"
"expected"
app_0
"found"
app_1
"in"
(let ((n_0 (object-name in_0)))
(if (path? n_0)
(unquoted-printing-string
(path->string n_0))
in_0))))))
(let ((tag_0 (read-byte in_0)))
(if (eqv? tag_0 66)
(let ((sha-1_0 (read-bytes 20 in_0)))
(let ((b-ht_0
(if as-correlated-linklet?_0
(read-correlated-linklet-bundle-hash
in_0)
(read-linklet-bundle-hash in_0))))
(begin
(if (hash? b-ht_0)
(void)
(let ((app_0 (format "~s" b-ht_0)))
(raise-read-error
'read-linklet-bundle-hash
"bad read result"
"expected"
"hash/c"
"found"
app_0
"in"
(let ((n_0 (object-name in_0)))
(if (path? n_0)
(path->string n_0)
in_0)))))
(hash->linklet-bundle
(add-hash-code
(if initial?_0
(strip-submodule-references b-ht_0)
b-ht_0)
sha-1_0)))))
(if (eqv? tag_0 68)
(begin
(if initial?_0
(void)
(raise-read-error
'read-compiled-linklet
"expected a linklet bundle"))
(read-bundle-directory_0 start-pos_0))
(raise-read-error
'read-compiled-linklet
"expected a `B` or `D`"))))))))))))))))
(read-bundle-directory_0
(|#%name|
read-bundle-directory
(lambda (pos_0)
(begin
(let ((count_0 (read-int in_0)))
(let ((position-to-name_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (count_1 accum_0)
(begin
(if (zero? count_1)
accum_0
(let ((bstr_0
(read-bytes (read-int in_0) in_0)))
(let ((offset_0 (read-int in_0)))
(let ((len_0 (read-int in_0)))
(begin
(read-int in_0)
(read-int in_0)
(let ((app_0 (sub1 count_1)))
(loop_0
app_0
(hash-set
accum_0
offset_0
bstr_0)))))))))))))
(loop_0 count_0 (hasheqv)))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (count_1 accum_0)
(begin
(if (zero? count_1)
(list->bundle-directory
accum_0
hash->linklet-directory)
(let ((name_0
(hash-ref
position-to-name_0
(- (file-position in_0) pos_0)
#f)))
(begin
(if name_0
(void)
(raise-read-error
'read-compiled-linklet
"bundle not at an expected file position"))
(let ((bstr_0 (read-bytes 2 in_0)))
(let ((bundle_0
(if (equal? #vu8(35 126) bstr_0)
(read-linklet-or-directory_0 #f)
(if (equal? #vu8(35 102) bstr_0)
#f
(raise-read-error
'read-compiled-linklet
"expected a `#~` or `#f` for a bundle")))))
(let ((app_0 (sub1 count_1)))
(loop_0
app_0
(cons
(cons (decode-name name_0 0) bundle_0)
accum_0)))))))))))))
(loop_0 count_0 '())))))))))
(read-linklet-or-directory_0 #t))))
(define read-int
(lambda (in_0) (integer-bytes->integer (read-bytes 4 in_0) #f #f)))
(define decode-name
(lambda (bstr_0 pos_0)
(let ((blen_0 (unsafe-bytes-length bstr_0)))
(let ((bad-bundle_0
(|#%name|
bad-bundle
(lambda ()
(begin
(raise-read-error
'read-compiled-linklet
"malformed bundle"))))))
(if (= pos_0 blen_0)
'()
(if (> pos_0 blen_0)
(bad-bundle_0)
(let ((len_0 (unsafe-bytes-ref bstr_0 pos_0)))
(begin
(if (> (+ pos_0 len_0 1) blen_0) (bad-bundle_0) (void))
(if (= len_0 255)
(let ((len_1
(let ((app_0 (add1 pos_0)))
(integer-bytes->integer
bstr_0
#f
#f
app_0
(+ pos_0 5)))))
(begin
(if (> (+ pos_0 len_1 1) blen_0) (bad-bundle_0) (void))
(let ((app_0
(string->symbol
(bytes->string/utf-8
(let ((app_0 (+ pos_0 5)))
(subbytes bstr_0 app_0 (+ pos_0 5 len_1)))
'#\x3f))))
(cons app_0 (decode-name bstr_0 (+ pos_0 5 len_1))))))
(let ((app_0
(string->symbol
(bytes->string/utf-8
(let ((app_0 (add1 pos_0)))
(subbytes bstr_0 app_0 (+ pos_0 1 len_0)))
'#\x3f))))
(cons
app_0
(decode-name bstr_0 (+ pos_0 1 len_0)))))))))))))
(define list->bundle-directory
(lambda (l_0 hash->linklet-directory_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1 prev-len_0 stack_0 accum_0)
(begin
(begin
(if (null? l_1)
(raise-read-error
'read-compiled-linklet
"invalid bundle sequence")
(void))
(let ((p_0 (car l_1)))
(let ((path_0 (car p_0)))
(let ((v_0 (cdr p_0)))
(let ((len_0 (length path_0)))
(begin
(if (< len_0 prev-len_0)
(raise-read-error
'read-compiled-linklet
"invalid bundle sequence")
(void))
(letrec*
((sloop_0
(|#%name|
sloop
(lambda (prev-len_1 stack_1 accum_1)
(begin
(if (> len_0 (add1 prev-len_1))
(let ((app_0 (add1 prev-len_1)))
(let ((app_1 (cons accum_1 stack_1)))
(sloop_0 app_0 app_1 (hasheq))))
(let ((path_1
(list-tail
path_0
(max 0 (sub1 prev-len_1)))))
(if (= len_0 prev-len_1)
(let ((accum_2
(if v_0
(hash-set accum_1 #f v_0)
accum_1)))
(if (zero? len_0)
(|#%app|
hash->linklet-directory_0
accum_2)
(let ((app_0 (cdr l_1)))
(let ((app_1 (sub1 prev-len_1)))
(let ((app_2 (cdr stack_1)))
(loop_0
app_0
app_1
app_2
(let ((app_3 (car stack_1)))
(let ((app_4 (car path_1)))
(hash-set
app_3
app_4
(|#%app|
hash->linklet-directory_0
accum_2))))))))))
(let ((path_2
(if (positive? prev-len_1)
(cdr path_1)
path_1)))
(let ((app_0 (cdr l_1)))
(loop_0
app_0
prev-len_1
stack_1
(let ((app_1 (car path_2)))
(hash-set
accum_1
app_1
(|#%app|
hash->linklet-directory_0
(if v_0
(hasheq #f v_0)
(hasheq))))))))))))))))
(sloop_0 prev-len_0 stack_0 accum_0)))))))))))))
(loop_0 l_0 0 '() (hasheq)))))
(define strip-submodule-references
(lambda (b-ht_0) (hash-remove (hash-remove b-ht_0 'pre) 'post)))
(define add-hash-code
(lambda (b-ht_0 sha-1_0)
(if (bytes=?
sha-1_0
#vu8(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
b-ht_0
(hash-set b-ht_0 'hash-code sha-1_0))))
(define raise-read-error
(lambda (who_0 msg_0 . details_0)
(raise
(let ((app_0
(let ((app_0 (format "~a: ~a" who_0 msg_0)))
(apply
string-append
app_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (details_1)
(begin
(if (null? details_1)
null
(let ((app_1 (car details_1)))
(let ((app_2 (format "~v" (cadr details_1))))
(list*
" "
app_1
": "
app_2
(loop_0 (cddr details_1)))))))))))
(loop_0 details_0))))))
(|#%app| exn:fail:read app_0 (current-continuation-marks) null)))))
(define read-syntax$1
(|#%name|
read-syntax
(lambda (src_0 in_0)
(begin
(if (default-read-handler? in_0)
(begin
(maybe-flush-stdout in_0)
(read*.1 #t #f #f unsafe-undefined #f src_0 in_0))
(values (|#%app| (port-read-handler in_0) in_0 src_0)))))))
(define read-syntax/recursive$1
(|#%name|
read-syntax/recursive
(lambda (src_0 in_0 start_0 readtable_0 graph?_0)
(begin
(let ((temp24_0 (not graph?_0)))
(read*.1 #t start_0 temp24_0 readtable_0 #t src_0 in_0))))))
(define read$1
(|#%name|
read
(lambda (in_0)
(begin
(if (default-read-handler? in_0)
(begin
(maybe-flush-stdout in_0)
(read*.1 #f #f #f unsafe-undefined #f #f in_0))
(values (|#%app| (port-read-handler in_0) in_0)))))))
(define read/recursive$1
(|#%name|
read/recursive
(lambda (in_0 start_0 readtable_0 graph?_0)
(begin
(let ((temp32_0 (not graph?_0)))
(read*.1 #f start_0 temp32_0 readtable_0 #t #f in_0))))))
(define read*.1
(|#%name|
read*
(lambda (for-syntax?1_0
init-c4_0
local-graph?6_0
readtable5_0
recursive?2_0
source3_0
in13_0)
(begin
(let ((readtable_0
(if (eq? readtable5_0 unsafe-undefined)
(1/current-readtable)
readtable5_0)))
(begin
(if log-performance? (start-performance-region 'read) (void))
(begin0
(let ((temp37_0 (if for-syntax?1_0 read-to-syntax #f)))
(let ((read-module-declared?44_0 read-module-declared?))
(let ((temp37_1 temp37_0))
(read.1
call-with-root-namespace
read-coerce
read-coerce-key
1/dynamic-require
for-syntax?1_0
init-c4_0
unsafe-undefined
local-graph?6_0
read-module-declared?44_0
unsafe-undefined
read-linklet-bundle-or-directory
readtable_0
recursive?2_0
source3_0
temp37_1
in13_0))))
(if log-performance? (end-performance-region) (void)))))))))
(define read-language$1
(|#%name|
read-language
(lambda (in_0 fail-thunk_0)
(begin
(let ((read-module-declared?54_0 read-module-declared?))
(read-language.1
call-with-root-namespace
read-coerce
read-coerce-key
1/dynamic-require
#t
read-module-declared?54_0
read-linklet-bundle-or-directory
read-to-syntax
in_0
fail-thunk_0))))))
(define read-to-syntax
(lambda (s-exp_0 srcloc_0 rep_0)
(if (syntax?$1 empty-syntax)
(let ((content*57_0 (datum-intern-literal s-exp_0)))
(let ((props59_0
(if (eqv? rep_0 '#\x5b)
original-square-props
(if (eqv? rep_0 '#\x7b)
original-curly-props
original-props))))
(let ((content*57_1 content*57_0))
(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)))
(define original-square-props
(syntax-props
(syntax-property$1
(syntax-property$1 empty-syntax original-property-sym #t)
'paren-shape
'#\x5b)))
(define original-curly-props
(syntax-props
(syntax-property$1
(syntax-property$1 empty-syntax original-property-sym #t)
'paren-shape
'#\x7b)))
(define read-module-declared?
(lambda (mod-path_0) (1/module-declared? mod-path_0 #t)))
(define read-coerce
(lambda (for-syntax?_0 v_0 srcloc_0)
(if (not for-syntax?_0)
(if (syntax?$1 v_0) (syntax->datum$1 v_0) v_0)
(if (syntax?$1 v_0)
v_0
(if (list? v_0)
(read-to-syntax
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(read-coerce #t e_0 srcloc_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null v_0))))
srcloc_0
#f)
(if (pair? v_0)
(read-to-syntax
(let ((app_0 (read-coerce #t (car v_0) srcloc_0)))
(cons app_0 (read-coerce #t (cdr v_0) srcloc_0)))
srcloc_0
#f)
(read-to-syntax v_0 srcloc_0 #f)))))))
(define read-coerce-key
(lambda (for-syntax?_0 k_0)
(if for-syntax?_0 (datum-intern-literal k_0) k_0)))
(define default-read-handler #f)
(define default-read-handler?
(lambda (in_0)
(if (not default-read-handler)
(begin (set! default-read-handler (port-read-handler in_0)) #t)
(let ((app_0 default-read-handler))
(eq? app_0 (port-read-handler in_0))))))
(define orig-input-port (current-input-port))
(define orig-output-port (current-output-port))
(define orig-error-port (current-error-port))
(define maybe-flush-stdout
(lambda (in_0)
(if (eq? in_0 orig-input-port)
(begin (flush-output orig-output-port) (flush-output orig-error-port))
(void))))
(define call-with-root-namespace
(lambda (thunk_0)
(let ((root-ns_0 (namespace-root-namespace (1/current-namespace))))
(if root-ns_0
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
root-ns_0)
(|#%app| thunk_0))
(|#%app| thunk_0)))))
(define 1/read-syntax
(let ((read-syntax_0
(|#%name|
read-syntax
(lambda (src1_0 in2_0)
(begin
(let ((src_0
(if (eq? src1_0 unsafe-undefined)
(object-name (current-input-port))
src1_0)))
(let ((in_0
(if (eq? in2_0 unsafe-undefined)
(current-input-port)
in2_0)))
(begin
(if (input-port? in_0)
(void)
(raise-argument-error 'read-syntax "input-port?" in_0))
(read-syntax$1 src_0 in_0)))))))))
(|#%name|
read-syntax
(case-lambda
(() (begin (read-syntax_0 unsafe-undefined unsafe-undefined)))
((src_0 in2_0) (read-syntax_0 src_0 in2_0))
((src1_0) (read-syntax_0 src1_0 unsafe-undefined))))))
(define 1/read-syntax/recursive
(let ((read-syntax/recursive_0
(|#%name|
read-syntax/recursive
(lambda (src3_0 in4_0 start5_0 readtable6_0 graph?7_0)
(begin
(let ((src_0
(if (eq? src3_0 unsafe-undefined)
(object-name (current-input-port))
src3_0)))
(let ((in_0
(if (eq? in4_0 unsafe-undefined)
(current-input-port)
in4_0)))
(let ((readtable_0
(if (eq? readtable6_0 unsafe-undefined)
(1/current-readtable)
readtable6_0)))
(begin
(if (input-port? in_0)
(void)
(raise-argument-error
'read-syntax/recursive
"input-port?"
in_0))
(if (let ((or-part_0 (not start5_0)))
(if or-part_0 or-part_0 (char? start5_0)))
(void)
(raise-argument-error
'read-syntax/recursive
"(or/c char? #f)"
start5_0))
(if (let ((or-part_0 (not readtable_0)))
(if or-part_0
or-part_0
(1/readtable? readtable_0)))
(void)
(raise-argument-error
'read-syntax/recursive
"(or/c readtable? #f)"
readtable_0))
(read-syntax/recursive$1
src_0
in_0
start5_0
readtable_0
graph?7_0))))))))))
(|#%name|
read-syntax/recursive
(case-lambda
(()
(begin
(read-syntax/recursive_0
unsafe-undefined
unsafe-undefined
#f
unsafe-undefined
#t)))
((src_0 in_0 start_0 readtable_0 graph?7_0)
(read-syntax/recursive_0 src_0 in_0 start_0 readtable_0 graph?7_0))
((src_0 in_0 start_0 readtable6_0)
(read-syntax/recursive_0 src_0 in_0 start_0 readtable6_0 #t))
((src_0 in_0 start5_0)
(read-syntax/recursive_0 src_0 in_0 start5_0 unsafe-undefined #t))
((src_0 in4_0)
(read-syntax/recursive_0 src_0 in4_0 #f unsafe-undefined #t))
((src3_0)
(read-syntax/recursive_0
src3_0
unsafe-undefined
#f
unsafe-undefined
#t))))))
(define 1/read
(let ((read_0
(|#%name|
read
(lambda (in8_0)
(begin
(let ((in_0
(if (eq? in8_0 unsafe-undefined)
(current-input-port)
in8_0)))
(begin
(if (input-port? in_0)
(void)
(raise-argument-error 'read "input-port?" in_0))
(read$1 in_0))))))))
(|#%name|
read
(case-lambda
(() (begin (read_0 unsafe-undefined)))
((in8_0) (read_0 in8_0))))))
(define 1/read/recursive
(let ((read/recursive_0
(|#%name|
read/recursive
(lambda (in9_0 start10_0 readtable11_0 graph?12_0)
(begin
(let ((in_0
(if (eq? in9_0 unsafe-undefined)
(current-input-port)
in9_0)))
(let ((readtable_0
(if (eq? readtable11_0 unsafe-undefined)
(1/current-readtable)
readtable11_0)))
(begin
(if (input-port? in_0)
(void)
(raise-argument-error
'read/recursive
"input-port?"
in_0))
(if (let ((or-part_0 (not start10_0)))
(if or-part_0 or-part_0 (char? start10_0)))
(void)
(raise-argument-error
'read/recursive
"(or/c char? #f)"
start10_0))
(if (let ((or-part_0 (not readtable_0)))
(if or-part_0 or-part_0 (1/readtable? readtable_0)))
(void)
(raise-argument-error
'read/recursive
"(or/c readtable? #f)"
readtable_0))
(read/recursive$1
in_0
start10_0
readtable_0
graph?12_0)))))))))
(|#%name|
read/recursive
(case-lambda
(() (begin (read/recursive_0 unsafe-undefined #f unsafe-undefined #t)))
((in_0 start_0 readtable_0 graph?12_0)
(read/recursive_0 in_0 start_0 readtable_0 graph?12_0))
((in_0 start_0 readtable11_0)
(read/recursive_0 in_0 start_0 readtable11_0 #t))
((in_0 start10_0) (read/recursive_0 in_0 start10_0 unsafe-undefined #t))
((in9_0) (read/recursive_0 in9_0 #f unsafe-undefined #t))))))
(define 1/read-language
(let ((read-language_0
(|#%name|
read-language
(lambda (in13_0 fail-thunk14_0)
(begin
(let ((in_0
(if (eq? in13_0 unsafe-undefined)
(current-input-port)
in13_0)))
(let ((fail-thunk_0
(if (eq? fail-thunk14_0 unsafe-undefined)
read-language-fail-thunk
fail-thunk14_0)))
(begin
(if (input-port? in_0)
(void)
(raise-argument-error 'read-language "input-port?" in_0))
(if (if (procedure? fail-thunk_0)
(procedure-arity-includes? fail-thunk_0 0)
#f)
(void)
(raise-argument-error
'read-language
"(procedure-arity-includes/c 0)"
fail-thunk_0))
(read-language$1
in_0
(if (eq? fail-thunk_0 read-language-fail-thunk)
#f
fail-thunk_0))))))))))
(|#%name|
read-language
(case-lambda
(() (begin (read-language_0 unsafe-undefined unsafe-undefined)))
((in_0 fail-thunk14_0) (read-language_0 in_0 fail-thunk14_0))
((in13_0) (read-language_0 in13_0 unsafe-undefined))))))
(define read-language-fail-thunk (lambda () (error "fail")))
(define declare-primitive-module!
(lambda (name_0 inst_0 in-ns_0 protected_0 cross-phase-persistent?_0)
(let ((mpi_0 (1/module-path-index-join (list 'quote name_0) #f)))
(let ((temp2_0
(let ((temp4_0 (1/current-module-declare-source)))
(let ((temp6_0 (zero? (hash-count protected_0))))
(let ((temp8_0
(hasheqv
0
(let ((lst_0 (instance-variable-names inst_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_1)
(begin
(if (pair? lst_1)
(let ((sym_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(let ((binding_0
(make-module-binding.1
#f
null
#f
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
mpi_0
0
sym_0)))
(values
sym_0
(if (hash-ref
protected_0
sym_0
#f)
(provided1.1
binding_0
#t
#f)
binding_0))))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 lst_0)))))))
(let ((temp9_0
(lambda (data-box_0
ns_0
phase-shift_0
phase-level_0
self_0
bulk-binding-registry_0
insp_0)
(if (= 0 phase-level_0)
(begin
(let ((lst_0 (instance-variable-names inst_0)))
(begin
(letrec*
((for-loop_0
(|#%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 ((val_0
(instance-variable-value
inst_0
sym_0)))
(namespace-set-variable!
ns_0
0
sym_0
val_0))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void))
(void)))))
(let ((temp8_1 temp8_0)
(temp6_1 temp6_0)
(temp4_1 temp4_0))
(make-module.1
cross-phase-persistent?_0
void
unsafe-undefined
temp9_0
#f
0
0
temp6_1
unsafe-undefined
#f
void
#f
temp8_1
null
mpi_0
temp4_1
null
#f))))))))
(let ((temp3_0 (substitute-module-declare-name name_0)))
(let ((temp2_1 temp2_0))
(declare-module!.1 #t in-ns_0 temp2_1 temp3_0)))))))
(define-values
(1/prop:exn:missing-module
1/exn:missing-module?
1/exn:missing-module-accessor)
(make-struct-type-property
'missing-module
(lambda (v_0 info_0)
(begin
(if (if (procedure? v_0) (procedure-arity-includes? v_0 1) #f)
(void)
(raise-argument-error
'guard-for-prop:exn:missing-module
"(procedure-arity-includes/c 1)"
v_0))
v_0))))
(define-values
(1/struct:exn:fail:filesystem:missing-module
1/make-exn:fail:filesystem:missing-module
1/exn:fail:filesystem:missing-module?
1/exn:fail:filesystem:missing-module-path)
(call-with-values
(lambda ()
(make-struct-type
'exn:fail:filesystem:missing-module
struct:exn:fail:filesystem
1
0
#f
(list
(cons
1/prop:exn:missing-module
(lambda (e_0)
(|#%app|
(check-not-unsafe-undefined
1/exn:fail:filesystem:missing-module-path
'1/exn:fail:filesystem:missing-module-path)
e_0))))
#f
#f
'(0)
#f
'exn:fail:filesystem:missing-module))
(case-lambda
((struct:_0 make-_0 ?_0 -ref_0 -set!_0)
(values struct:_0 make-_0 ?_0 (make-struct-field-accessor -ref_0 0 'path)))
(args (raise-binding-result-arity-error 5 args)))))
(define-values
(1/struct:exn:fail:syntax:missing-module
1/make-exn:fail:syntax:missing-module
1/exn:fail:syntax:missing-module?
1/exn:fail:syntax:missing-module-path)
(call-with-values
(lambda ()
(make-struct-type
'exn:fail:syntax:missing-module
1/struct:exn:fail:syntax
1
0
#f
(list
(cons
1/prop:exn:missing-module
(lambda (e_0)
(|#%app|
(check-not-unsafe-undefined
1/exn:fail:syntax:missing-module-path
'1/exn:fail:syntax:missing-module-path)
e_0))))
#f
#f
'(0)
#f
'exn:fail:syntax:missing-module))
(case-lambda
((struct:_0 make-_0 ?_0 -ref_0 -set!_0)
(values struct:_0 make-_0 ?_0 (make-struct-field-accessor -ref_0 0 'path)))
(args (raise-binding-result-arity-error 5 args)))))
(define 1/current-module-path-for-load
(make-parameter
#f
(lambda (v_0)
(begin
(if (let ((or-part_0 (not v_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (1/module-path? v_0)))
(if or-part_1
or-part_1
(if (syntax?$1 v_0)
(1/module-path? (syntax->datum$1 v_0))
#f)))))
(void)
(raise-argument-error
'current-module-path-for-load
(string-append
"(or/c module-path?"
" (and/c syntax? (lambda (stx) (module-path? (syntax->datum stx))))"
" #f)")
v_0))
v_0))
'current-module-path-for-load))
(define maybe-raise-missing-module
(lambda (name_0 filename_0 pre_0 rel_0 post_0 errstr_0)
(let ((path_0 (1/current-module-path-for-load)))
(if path_0
(begin
(if (syntax?$1 path_0)
(raise
(let ((app_0
(let ((app_0
(string-append
"~a: cannot open module file\n"
" module path: ~a\n"
" path: ~a~a~a~a\n"
" system error: ~a")))
(let ((app_1
(if (syntax-srcloc path_0)
(srcloc->string (syntax-srcloc path_0))
name_0)))
(format
app_0
app_1
(syntax->datum$1 path_0)
filename_0
pre_0
rel_0
post_0
errstr_0)))))
(let ((app_1 (current-continuation-marks)))
(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
(format
(string-append
"~a: cannot open module file\n"
" module path: ~a\n"
" path: ~a~a~a~a\n"
" system error: ~a")
name_0
path_0
filename_0
pre_0
rel_0
post_0
errstr_0)))
(|#%app|
1/make-exn:fail:filesystem:missing-module
app_0
(current-continuation-marks)
path_0))))
(void)))))
(define 1/local-expand
(let ((local-expand_0
(|#%name|
local-expand
(lambda (s2_0 context3_0 stop-ids4_0 intdefs1_0)
(begin
(do-local-expand.1
#f
#f
#t
unsafe-undefined
#f
#f
#f
'local-expand
s2_0
context3_0
stop-ids4_0
intdefs1_0))))))
(|#%name|
local-expand
(case-lambda
((s_0 context_0 stop-ids_0)
(begin (local-expand_0 s_0 context_0 stop-ids_0 '())))
((s_0 context_0 stop-ids_0 intdefs1_0)
(local-expand_0 s_0 context_0 stop-ids_0 intdefs1_0))))))
(define 1/local-expand/capture-lifts
(let ((local-expand/capture-lifts_0
(|#%name|
local-expand/capture-lifts
(lambda (s7_0 context8_0 stop-ids9_0 intdefs5_0 lift-key6_0)
(begin
(let ((lift-key_0
(if (eq? lift-key6_0 unsafe-undefined)
(generate-lift-key)
lift-key6_0)))
(do-local-expand.1
#f
#t
#t
lift-key_0
#f
#f
#f
'local-expand
s7_0
context8_0
stop-ids9_0
intdefs5_0)))))))
(|#%name|
local-expand/capture-lifts
(case-lambda
((s_0 context_0 stop-ids_0)
(begin
(local-expand/capture-lifts_0
s_0
context_0
stop-ids_0
'()
unsafe-undefined)))
((s_0 context_0 stop-ids_0 intdefs_0 lift-key6_0)
(local-expand/capture-lifts_0
s_0
context_0
stop-ids_0
intdefs_0
lift-key6_0))
((s_0 context_0 stop-ids_0 intdefs5_0)
(local-expand/capture-lifts_0
s_0
context_0
stop-ids_0
intdefs5_0
unsafe-undefined))))))
(define 1/local-transformer-expand
(let ((local-transformer-expand_0
(|#%name|
local-transformer-expand
(lambda (s11_0 context12_0 stop-ids13_0 intdefs10_0)
(begin
(do-local-expand.1
#t
#f
#t
unsafe-undefined
#f
#f
#f
'local-expand
s11_0
context12_0
stop-ids13_0
intdefs10_0))))))
(|#%name|
local-transformer-expand
(case-lambda
((s_0 context_0 stop-ids_0)
(begin (local-transformer-expand_0 s_0 context_0 stop-ids_0 '())))
((s_0 context_0 stop-ids_0 intdefs10_0)
(local-transformer-expand_0 s_0 context_0 stop-ids_0 intdefs10_0))))))
(define 1/local-transformer-expand/capture-lifts
(let ((local-transformer-expand/capture-lifts_0
(|#%name|
local-transformer-expand/capture-lifts
(lambda (s16_0 context17_0 stop-ids18_0 intdefs14_0 lift-key15_0)
(begin
(let ((lift-key_0
(if (eq? lift-key15_0 unsafe-undefined)
(generate-lift-key)
lift-key15_0)))
(do-local-expand.1
#t
#t
#t
lift-key_0
#f
#f
#f
'local-expand
s16_0
context17_0
stop-ids18_0
intdefs14_0)))))))
(|#%name|
local-transformer-expand/capture-lifts
(case-lambda
((s_0 context_0 stop-ids_0)
(begin
(local-transformer-expand/capture-lifts_0
s_0
context_0
stop-ids_0
'()
unsafe-undefined)))
((s_0 context_0 stop-ids_0 intdefs_0 lift-key15_0)
(local-transformer-expand/capture-lifts_0
s_0
context_0
stop-ids_0
intdefs_0
lift-key15_0))
((s_0 context_0 stop-ids_0 intdefs14_0)
(local-transformer-expand/capture-lifts_0
s_0
context_0
stop-ids_0
intdefs14_0
unsafe-undefined))))))
(define 1/syntax-local-expand-expression
(let ((syntax-local-expand-expression_0
(|#%name|
syntax-local-expand-expression
(lambda (s20_0 opaque-only?19_0)
(begin
(let ((exp-s_0
(do-local-expand.1
#f
#f
#f
unsafe-undefined
#t
opaque-only?19_0
#t
'syntax-local-expand-expression
s20_0
'expression
null
#f)))
(let ((ctx_0 (get-current-expand-context.1 #f 'unexpected)))
(let ((ae_0
(let ((s_0
(datum->syntax$1
#f
(already-expanded1.1
(if (parsed? exp-s_0)
exp-s_0
(begin-unsafe
(flip-scopes
exp-s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0)))))
(begin-unsafe
(expand-context/outer-binding-layer
ctx_0))))))
(begin-unsafe
(flip-scopes
s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_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 'opaque-expr ae_0)
(void)))
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'exit-local exp-s_0)
(void)))
(values
(if (not opaque-only?19_0) exp-s_0 #f)
ae_0))))))))))
(|#%name|
syntax-local-expand-expression
(case-lambda
((s_0) (begin (syntax-local-expand-expression_0 s_0 #f)))
((s_0 opaque-only?19_0)
(syntax-local-expand-expression_0 s_0 opaque-only?19_0))))))
(define do-local-expand.1
(|#%name|
do-local-expand
(lambda (as-transformer?22_0
capture-lifts?21_0
|keep-#%expression?24_0|
lift-key25_0
skip-log-exit?27_0
to-parsed-ok?23_0
track-to-be-defined?26_0
who36_0
s-or-s-exp37_0
context38_0
stop-ids39_0
intdefs35_0)
(begin
(let ((lift-key_0
(if (eq? lift-key25_0 unsafe-undefined)
(if (if capture-lifts?21_0
capture-lifts?21_0
as-transformer?22_0)
(generate-lift-key)
#f)
lift-key25_0)))
(begin
(if log-performance?
(start-performance-region 'expand 'local-expand)
(void))
(begin0
(let ((s_0 (datum->syntax$1 #f s-or-s-exp37_0)))
(begin
(if (let ((or-part_0 (list? context38_0)))
(if or-part_0
or-part_0
(memq
context38_0
(if as-transformer?22_0
'(expression top-level)
'(expression top-level module module-begin)))))
(void)
(raise-argument-error
who36_0
(if as-transformer?22_0
"(or/c 'expression 'top-level list?)"
"(or/c 'expression 'top-level 'module 'module-begin list?)")
context38_0))
(begin
(if (let ((or-part_0 (not stop-ids39_0)))
(if or-part_0
or-part_0
(if (list? stop-ids39_0)
(andmap_2344 identifier? stop-ids39_0)
#f)))
(void)
(raise-argument-error
who36_0
"(or/c (listof identifier?) #f)"
stop-ids39_0))
(begin
(if (intdefs-or-false? intdefs35_0)
(void)
(raise-argument-error
who36_0
intdefs-or-false?-string
intdefs35_0))
(let ((ctx_0 (get-current-expand-context.1 #f who36_0)))
(let ((phase_0
(if as-transformer?22_0
(add1
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))))
(let ((local-ctx_0
(let ((temp83_0
(if |keep-#%expression?24_0|
|keep-#%expression?24_0|
(if (begin-unsafe
(expand-context/inner-in-local-expand?
(root-expand-context/outer-inner
ctx_0)))
(begin-unsafe
(|expand-context/inner-keep-#%expression?|
(root-expand-context/outer-inner
ctx_0)))
#f))))
(make-local-expand-context.1
context38_0
intdefs35_0
temp83_0
phase_0
stop-ids39_0
to-parsed-ok?23_0
track-to-be-defined?26_0
ctx_0))))
(begin
(with-continuation-mark*
push-authentic
current-expand-context
#f
(if (begin-unsafe
(expand-context/inner-skip-visit-available?
(root-expand-context/outer-inner ctx_0)))
(void)
(namespace-visit-available-modules!
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))
phase_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
local-ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'enter-local s_0)
(void)))
(let ((input-s_0
(let ((temp85_0
(begin-unsafe
(flip-scopes
s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0))))))
(add-intdef-scopes.1
unsafe-undefined
#f
temp85_0
intdefs35_0))))
(begin
(if as-transformer?22_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
local-ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'phase-up)
(void)))
(void))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
local-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'local-pre
input-s_0)
(void)))
(begin
(if stop-ids39_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
local-ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'start)
(void)))
(void))
(let ((output-s_0
(with-continuation-mark*
push-authentic
current-expand-context
#f
(if (if as-transformer?22_0
capture-lifts?21_0
#f)
(expand-transformer.1
#t
#t
context38_0
#f
#t
lift-key_0
input-s_0
local-ctx_0)
(if as-transformer?22_0
(let ((temp99_0
(eq?
'top-level
context38_0)))
(expand-transformer.1
#f
temp99_0
context38_0
#f
#t
lift-key_0
input-s_0
local-ctx_0))
(if capture-lifts?21_0
(expand/capture-lifts.1
#t
#t
#f
lift-key_0
input-s_0
local-ctx_0)
(expand.1
#f
#f
input-s_0
local-ctx_0)))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
local-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'local-post
output-s_0)
(void)))
(let ((result-s_0
(if (parsed? output-s_0)
output-s_0
(begin-unsafe
(flip-scopes
output-s_0
(begin-unsafe
(expand-context/outer-current-introduction-scopes
ctx_0)))))))
(begin
(if skip-log-exit?27_0
(void)
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
local-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-local
result-s_0)
(void))))
result-s_0)))))))))))))))))
(if log-performance? (end-performance-region) (void)))))))))
(define 1/syntax-tainted?
(|#%name|
syntax-tainted?
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-tainted? "syntax?" s_0))
(syntax-tainted?$1 s_0))))))
(define 1/syntax-arm
(let ((syntax-arm_0
(|#%name|
syntax-arm
(lambda (s3_0 maybe-insp1_0 use-mode?2_0)
(begin
(begin
(if (syntax?$1 s3_0)
(void)
(raise-argument-error 'syntax-arm "syntax?" s3_0))
(begin
(if (let ((or-part_0 (not maybe-insp1_0)))
(if or-part_0 or-part_0 (inspector? maybe-insp1_0)))
(void)
(raise-argument-error
'syntax-arm
"(or/c inspector? #f)"
maybe-insp1_0))
(let ((insp_0 (inspector-for-taint maybe-insp1_0)))
(let ((armed-s_0
(if use-mode?2_0
(taint-dispatch
s3_0
(lambda (s_0) (syntax-arm$1 s_0 insp_0))
(1/syntax-local-phase-level))
(syntax-arm$1 s3_0 insp_0))))
(let ((ctx_0
(get-current-expand-context.1 #t 'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'arm
armed-s_0
s3_0)
(void)))
(void))
armed-s_0)))))))))))
(|#%name|
syntax-arm
(case-lambda
((s_0) (begin (syntax-arm_0 s_0 #f #f)))
((s_0 maybe-insp_0 use-mode?2_0)
(syntax-arm_0 s_0 maybe-insp_0 use-mode?2_0))
((s_0 maybe-insp1_0) (syntax-arm_0 s_0 maybe-insp1_0 #f))))))
(define 1/syntax-disarm
(|#%name|
syntax-disarm
(lambda (s_0 maybe-insp_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-disarm "syntax?" s_0))
(begin
(if (let ((or-part_0 (not maybe-insp_0)))
(if or-part_0 or-part_0 (inspector? maybe-insp_0)))
(void)
(raise-argument-error
'syntax-disarm
"(or/c inspector? #f)"
maybe-insp_0))
(let ((insp_0 (inspector-for-taint maybe-insp_0)))
(let ((disarmed-s_0 (syntax-disarm$1 s_0 insp_0)))
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'disarm
disarmed-s_0
s_0)
(void)))
(void))
disarmed-s_0))))))))))
(define 1/syntax-rearm
(let ((syntax-rearm_0
(|#%name|
syntax-rearm
(lambda (s5_0 from-s6_0 use-mode?4_0)
(begin
(begin
(if (syntax?$1 s5_0)
(void)
(raise-argument-error 'syntax-rearm "syntax?" s5_0))
(begin
(if (syntax?$1 from-s6_0)
(void)
(raise-argument-error 'syntax-rearm "syntax?" from-s6_0))
(let ((rearmed-s_0
(if use-mode?4_0
(taint-dispatch
s5_0
(lambda (s_0) (syntax-rearm$1 s_0 from-s6_0))
(1/syntax-local-phase-level))
(syntax-rearm$1 s5_0 from-s6_0))))
(let ((ctx_0
(get-current-expand-context.1 #t 'unexpected)))
(begin
(if ctx_0
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'rearm
rearmed-s_0
s5_0)
(void)))
(void))
rearmed-s_0))))))))))
(|#%name|
syntax-rearm
(case-lambda
((s_0 from-s_0) (begin (syntax-rearm_0 s_0 from-s_0 #f)))
((s_0 from-s_0 use-mode?4_0)
(syntax-rearm_0 s_0 from-s_0 use-mode?4_0))))))
(define 1/syntax-taint
(|#%name|
syntax-taint
(lambda (s_0)
(begin
(begin
(if (syntax?$1 s_0)
(void)
(raise-argument-error 'syntax-taint "syntax?" s_0))
(syntax-taint$1 s_0))))))
(define inspector-for-taint
(lambda (maybe-insp_0)
(if maybe-insp_0
maybe-insp_0
(let ((or-part_0 (current-module-code-inspector)))
(if or-part_0 or-part_0 (current-code-inspector))))))
(define 1/variable-reference->empty-namespace
(|#%name|
variable-reference->empty-namespace
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->empty-namespace
"variable-reference?"
vr_0))
(let ((temp2_0 (1/variable-reference->namespace vr_0)))
(new-namespace.1 #t unsafe-undefined temp2_0)))))))
(define 1/variable-reference->namespace
(|#%name|
variable-reference->namespace
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->namespace
"variable-reference?"
vr_0))
(let ((ns_0 (variable-reference->namespace* vr_0)))
(let ((mpi_0 (namespace-mpi ns_0)))
(begin
(if (non-self-module-path-index? mpi_0)
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
ns_0)
(let ((temp6_0 (namespace-0-phase ns_0)))
(namespace-module-make-available!.1
unsafe-undefined
ns_0
mpi_0
temp6_0)))
(void))
ns_0))))))))
(define variable-reference->namespace*
(lambda (vr_0)
(let ((inst_0 (variable-reference->instance vr_0)))
(if (symbol? inst_0)
(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))))))
(define 1/variable-reference->module-path-index
(|#%name|
variable-reference->module-path-index
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->module-path-index
"variable-reference?"
vr_0))
(let ((mpi_0 (namespace-mpi (variable-reference->namespace* vr_0))))
(if (begin-unsafe (eq? top-level-module-path-index mpi_0))
#f
mpi_0)))))))
(define 1/variable-reference->resolved-module-path
(|#%name|
variable-reference->resolved-module-path
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->resolved-module-path
"variable-reference?"
vr_0))
(let ((mpi_0 (1/variable-reference->module-path-index vr_0)))
(if mpi_0 (1/module-path-index-resolve mpi_0) #f)))))))
(define 1/variable-reference->module-source
(|#%name|
variable-reference->module-source
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->module-source
"variable-reference?"
vr_0))
(let ((ns_0 (variable-reference->namespace* vr_0)))
(namespace-source-name ns_0)))))))
(define 1/variable-reference->phase
(|#%name|
variable-reference->phase
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->phase
"variable-reference?"
vr_0))
(namespace-phase (variable-reference->namespace* vr_0)))))))
(define 1/variable-reference->module-base-phase
(|#%name|
variable-reference->module-base-phase
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->module-base-phase
"variable-reference?"
vr_0))
(namespace-0-phase (variable-reference->namespace* vr_0)))))))
(define 1/variable-reference->module-declaration-inspector
(|#%name|
variable-reference->module-declaration-inspector
(lambda (vr_0)
(begin
(begin
(if (variable-reference? vr_0)
(void)
(raise-argument-error
'variable-reference->module-declaration-inspector
"variable-reference?"
vr_0))
(if (variable-reference->instance vr_0)
(raise-arguments-error
'variable-reference->module-declaration-inspector
"variable reference does not refer to an anonymous module variable"
"variable reference"
vr_0)
(void))
(let ((or-part_0
(namespace-declaration-inspector
(variable-reference->namespace* vr_0))))
(if or-part_0
or-part_0
(raise-arguments-error
'variable-reference->module-declaration-inspector
"given variable reference is not from a module"))))))))
(define primitive-ids
(seteq
'syntax?
'syntax-e
'syntax->datum
'datum->syntax
'bound-identifier=?
'free-identifier=?
'free-transformer-identifier=?
'free-template-identifier=?
'free-label-identifier=?
'identifier-binding
'identifier-transformer-binding
'identifier-template-binding
'identifier-label-binding
'identifier-binding-symbol
'identifier-prune-lexical-context
'syntax-debug-info
'syntax-track-origin
'syntax-shift-phase-level
'syntax-source-module
'identifier-prune-to-source-module
'syntax-source
'syntax-line
'syntax-column
'syntax-position
'syntax-span
'syntax->list
'syntax-property
'syntax-property-remove
'syntax-property-preserved?
'syntax-property-symbol-keys
'syntax-original?
'syntax-tainted?
'syntax-arm
'syntax-disarm
'syntax-rearm
'syntax-taint
'syntax-binding-set
'syntax-binding-set?
'syntax-binding-set-extend
'syntax-binding-set->syntax
'raise-syntax-error
'struct:exn:fail:syntax
'exn:fail:syntax
'make-exn:fail:syntax
'exn:fail:syntax?
'exn:fail:syntax-exprs
'struct:exn:fail:syntax:unbound
'exn:fail:syntax:unbound
'make-exn:fail:syntax:unbound
'exn:fail:syntax:unbound?
'current-module-path-for-load
'prop:exn:missing-module
'exn:missing-module?
'exn:missing-module-accessor
'struct:exn:fail:filesystem:missing-module
'exn:fail:filesystem:missing-module
'make-exn:fail:filesystem:missing-module
'exn:fail:filesystem:missing-module?
'exn:fail:filesystem:missing-module-path
'struct:exn:fail:syntax:missing-module
'exn:fail:syntax:missing-module
'make-exn:fail:syntax:missing-module
'exn:fail:syntax:missing-module?
'exn:fail:syntax:missing-module-path
'syntax-transforming?
'syntax-transforming-with-lifts?
'syntax-transforming-module-expression?
'syntax-local-transforming-module-provides?
'syntax-local-context
'syntax-local-introduce
'syntax-local-identifier-as-binding
'syntax-local-phase-level
'syntax-local-name
'make-syntax-introducer
'make-interned-syntax-introducer
'make-syntax-delta-introducer
'syntax-local-make-delta-introducer
'syntax-local-value
'syntax-local-value/immediate
'syntax-local-lift-expression
'syntax-local-lift-values-expression
'syntax-local-lift-context
'syntax-local-lift-module
'syntax-local-lift-require
'syntax-local-lift-provide
'syntax-local-lift-module-end-declaration
'syntax-local-module-defined-identifiers
'syntax-local-module-required-identifiers
'syntax-local-module-exports
'syntax-local-submodules
'syntax-local-get-shadower
'local-expand
'local-expand/capture-lifts
'local-transformer-expand
'local-transformer-expand/capture-lifts
'syntax-local-expand-expression
'internal-definition-context?
'syntax-local-make-definition-context
'syntax-local-bind-syntaxes
'internal-definition-context-binding-identifiers
'internal-definition-context-introduce
'internal-definition-context-seal
'identifier-remove-from-definition-context
'make-set!-transformer
'prop:set!-transformer
'set!-transformer?
'set!-transformer-procedure
'rename-transformer?
'prop:rename-transformer
'make-rename-transformer
'rename-transformer-target
'prop:liberal-define-context
'liberal-define-context?
'prop:expansion-contexts
'module-path?
'resolved-module-path?
'make-resolved-module-path
'resolved-module-path-name
'module-path-index?
'module-path-index-resolve
'module-path-index-join
'module-path-index-split
'module-path-index-submodule
'current-module-name-resolver
'current-module-declare-name
'current-module-declare-source
'current-namespace
'namespace-module-registry
'namespace?
'variable-reference->empty-namespace
'variable-reference->namespace
'variable-reference->resolved-module-path
'variable-reference->module-path-index
'variable-reference->module-source
'variable-reference->phase
'variable-reference->module-base-phase
'variable-reference->module-declaration-inspector
'read-syntax
'read-syntax/recursive))
(define effect_2769
(begin
(void
(begin
(add-core-primitive! 'syntax? syntax?$1)
(add-core-primitive! 'syntax-e 1/syntax-e)
(add-core-primitive! 'syntax->datum 1/syntax->datum)
(add-core-primitive! 'datum->syntax 1/datum->syntax)
(add-core-primitive! 'bound-identifier=? 1/bound-identifier=?)
(add-core-primitive! 'free-identifier=? 1/free-identifier=?)
(add-core-primitive!
'free-transformer-identifier=?
1/free-transformer-identifier=?)
(add-core-primitive!
'free-template-identifier=?
1/free-template-identifier=?)
(add-core-primitive! 'free-label-identifier=? 1/free-label-identifier=?)
(add-core-primitive! 'identifier-binding 1/identifier-binding)
(add-core-primitive!
'identifier-transformer-binding
1/identifier-transformer-binding)
(add-core-primitive!
'identifier-template-binding
1/identifier-template-binding)
(add-core-primitive!
'identifier-label-binding
1/identifier-label-binding)
(add-core-primitive!
'identifier-binding-symbol
1/identifier-binding-symbol)
(add-core-primitive!
'identifier-prune-lexical-context
1/identifier-prune-lexical-context)
(add-core-primitive! 'syntax-debug-info 1/syntax-debug-info)
(add-core-primitive! 'syntax-track-origin 1/syntax-track-origin)
(add-core-primitive!
'syntax-shift-phase-level
1/syntax-shift-phase-level)
(add-core-primitive! 'syntax-source-module 1/syntax-source-module)
(add-core-primitive!
'identifier-prune-to-source-module
1/identifier-prune-to-source-module)
(add-core-primitive! 'syntax-source 1/syntax-source)
(add-core-primitive! 'syntax-line 1/syntax-line)
(add-core-primitive! 'syntax-column 1/syntax-column)
(add-core-primitive! 'syntax-position 1/syntax-position)
(add-core-primitive! 'syntax-span 1/syntax-span)
(add-core-primitive! 'syntax->list 1/syntax->list)
(add-core-primitive! 'syntax-property syntax-property$1)
(add-core-primitive! 'syntax-property-remove 1/syntax-property-remove)
(add-core-primitive!
'syntax-property-preserved?
1/syntax-property-preserved?)
(add-core-primitive!
'syntax-property-symbol-keys
1/syntax-property-symbol-keys)
(add-core-primitive! 'syntax-original? 1/syntax-original?)
(add-core-primitive! 'syntax-tainted? 1/syntax-tainted?)
(add-core-primitive! 'syntax-arm 1/syntax-arm)
(add-core-primitive! 'syntax-disarm 1/syntax-disarm)
(add-core-primitive! 'syntax-rearm 1/syntax-rearm)
(add-core-primitive! 'syntax-taint 1/syntax-taint)
(add-core-primitive! 'syntax-binding-set 1/syntax-binding-set)
(add-core-primitive! 'syntax-binding-set? 1/syntax-binding-set?)
(add-core-primitive!
'syntax-binding-set-extend
1/syntax-binding-set-extend)
(add-core-primitive!
'syntax-binding-set->syntax
1/syntax-binding-set->syntax)
(add-core-primitive! 'raise-syntax-error raise-syntax-error$1)
(add-core-primitive! 'struct:exn:fail:syntax 1/struct:exn:fail:syntax)
(add-core-primitive! 'exn:fail:syntax make-exn:fail:syntax$1)
(add-core-primitive! 'make-exn:fail:syntax make-exn:fail:syntax$1)
(add-core-primitive! 'exn:fail:syntax? 1/exn:fail:syntax?)
(add-core-primitive!
'exn:fail:syntax-exprs
(check-not-unsafe-undefined
1/exn:fail:syntax-exprs
'1/exn:fail:syntax-exprs))
(add-core-primitive!
'struct:exn:fail:syntax:unbound
1/struct:exn:fail:syntax:unbound)
(add-core-primitive!
'exn:fail:syntax:unbound
make-exn:fail:syntax:unbound$1)
(add-core-primitive!
'make-exn:fail:syntax:unbound
make-exn:fail:syntax:unbound$1)
(add-core-primitive!
'exn:fail:syntax:unbound?
1/exn:fail:syntax:unbound?)
(add-core-primitive!
'current-module-path-for-load
1/current-module-path-for-load)
(add-core-primitive! 'prop:exn:missing-module 1/prop:exn:missing-module)
(add-core-primitive! 'exn:missing-module? 1/exn:missing-module?)
(add-core-primitive!
'exn:missing-module-accessor
1/exn:missing-module-accessor)
(add-core-primitive!
'struct:exn:fail:filesystem:missing-module
1/struct:exn:fail:filesystem:missing-module)
(add-core-primitive!
'exn:fail:filesystem:missing-module
1/make-exn:fail:filesystem:missing-module)
(add-core-primitive!
'make-exn:fail:filesystem:missing-module
1/make-exn:fail:filesystem:missing-module)
(add-core-primitive!
'exn:fail:filesystem:missing-module?
1/exn:fail:filesystem:missing-module?)
(add-core-primitive!
'exn:fail:filesystem:missing-module-path
(check-not-unsafe-undefined
1/exn:fail:filesystem:missing-module-path
'1/exn:fail:filesystem:missing-module-path))
(add-core-primitive!
'struct:exn:fail:syntax:missing-module
1/struct:exn:fail:syntax:missing-module)
(add-core-primitive!
'exn:fail:syntax:missing-module
1/make-exn:fail:syntax:missing-module)
(add-core-primitive!
'make-exn:fail:syntax:missing-module
1/make-exn:fail:syntax:missing-module)
(add-core-primitive!
'exn:fail:syntax:missing-module?
1/exn:fail:syntax:missing-module?)
(add-core-primitive!
'exn:fail:syntax:missing-module-path
(check-not-unsafe-undefined
1/exn:fail:syntax:missing-module-path
'1/exn:fail:syntax:missing-module-path))
(add-core-primitive! 'syntax-transforming? 1/syntax-transforming?)
(add-core-primitive!
'syntax-transforming-with-lifts?
1/syntax-transforming-with-lifts?)
(add-core-primitive!
'syntax-transforming-module-expression?
1/syntax-transforming-module-expression?)
(add-core-primitive!
'syntax-local-transforming-module-provides?
1/syntax-local-transforming-module-provides?)
(add-core-primitive! 'syntax-local-context 1/syntax-local-context)
(add-core-primitive! 'syntax-local-introduce 1/syntax-local-introduce)
(add-core-primitive!
'syntax-local-identifier-as-binding
1/syntax-local-identifier-as-binding)
(add-core-primitive!
'syntax-local-phase-level
1/syntax-local-phase-level)
(add-core-primitive! 'syntax-local-name 1/syntax-local-name)
(add-core-primitive! 'make-syntax-introducer 1/make-syntax-introducer)
(add-core-primitive!
'make-interned-syntax-introducer
1/make-interned-syntax-introducer)
(add-core-primitive!
'make-syntax-delta-introducer
1/make-syntax-delta-introducer)
(add-core-primitive!
'syntax-local-make-delta-introducer
1/syntax-local-make-delta-introducer)
(add-core-primitive! 'syntax-local-value 1/syntax-local-value)
(add-core-primitive!
'syntax-local-value/immediate
1/syntax-local-value/immediate)
(add-core-primitive!
'syntax-local-lift-expression
1/syntax-local-lift-expression)
(add-core-primitive!
'syntax-local-lift-values-expression
1/syntax-local-lift-values-expression)
(add-core-primitive!
'syntax-local-lift-context
1/syntax-local-lift-context)
(add-core-primitive!
'syntax-local-lift-module
1/syntax-local-lift-module)
(add-core-primitive!
'syntax-local-lift-require
1/syntax-local-lift-require)
(add-core-primitive!
'syntax-local-lift-provide
1/syntax-local-lift-provide)
(add-core-primitive!
'syntax-local-lift-module-end-declaration
1/syntax-local-lift-module-end-declaration)
(add-core-primitive!
'syntax-local-module-defined-identifiers
1/syntax-local-module-defined-identifiers)
(add-core-primitive!
'syntax-local-module-required-identifiers
1/syntax-local-module-required-identifiers)
(add-core-primitive!
'syntax-local-module-exports
1/syntax-local-module-exports)
(add-core-primitive! 'syntax-local-submodules 1/syntax-local-submodules)
(add-core-primitive!
'syntax-local-get-shadower
1/syntax-local-get-shadower)
(add-core-primitive! 'local-expand 1/local-expand)
(add-core-primitive!
'local-expand/capture-lifts
1/local-expand/capture-lifts)
(add-core-primitive!
'local-transformer-expand
1/local-transformer-expand)
(add-core-primitive!
'local-transformer-expand/capture-lifts
1/local-transformer-expand/capture-lifts)
(add-core-primitive!
'syntax-local-expand-expression
1/syntax-local-expand-expression)
(add-core-primitive!
'internal-definition-context?
1/internal-definition-context?)
(add-core-primitive!
'syntax-local-make-definition-context
1/syntax-local-make-definition-context)
(add-core-primitive!
'syntax-local-bind-syntaxes
1/syntax-local-bind-syntaxes)
(add-core-primitive!
'internal-definition-context-binding-identifiers
1/internal-definition-context-binding-identifiers)
(add-core-primitive!
'internal-definition-context-introduce
1/internal-definition-context-introduce)
(add-core-primitive!
'internal-definition-context-seal
1/internal-definition-context-seal)
(add-core-primitive!
'identifier-remove-from-definition-context
1/identifier-remove-from-definition-context)
(add-core-primitive! 'make-set!-transformer 1/make-set!-transformer)
(add-core-primitive! 'prop:set!-transformer 1/prop:set!-transformer)
(add-core-primitive! 'set!-transformer? 1/set!-transformer?)
(add-core-primitive!
'set!-transformer-procedure
1/set!-transformer-procedure)
(add-core-primitive! 'rename-transformer? 1/rename-transformer?)
(add-core-primitive! 'prop:rename-transformer 1/prop:rename-transformer)
(add-core-primitive! 'make-rename-transformer 1/make-rename-transformer)
(add-core-primitive!
'rename-transformer-target
1/rename-transformer-target)
(add-core-primitive!
'prop:liberal-define-context
1/prop:liberal-define-context)
(add-core-primitive!
'liberal-define-context?
has-liberal-define-context-property?)
(add-core-primitive! 'prop:expansion-contexts 1/prop:expansion-contexts)
(add-core-primitive! 'module-path? 1/module-path?)
(add-core-primitive! 'resolved-module-path? 1/resolved-module-path?)
(add-core-primitive!
'make-resolved-module-path
1/make-resolved-module-path)
(add-core-primitive!
'resolved-module-path-name
1/resolved-module-path-name)
(add-core-primitive! 'module-path-index? 1/module-path-index?)
(add-core-primitive!
'module-path-index-resolve
1/module-path-index-resolve)
(add-core-primitive! 'module-path-index-join 1/module-path-index-join)
(add-core-primitive! 'module-path-index-split 1/module-path-index-split)
(add-core-primitive!
'module-path-index-submodule
1/module-path-index-submodule)
(add-core-primitive!
'current-module-name-resolver
1/current-module-name-resolver)
(add-core-primitive!
'current-module-declare-name
1/current-module-declare-name)
(add-core-primitive!
'current-module-declare-source
1/current-module-declare-source)
(add-core-primitive! 'current-namespace 1/current-namespace)
(add-core-primitive!
'namespace-module-registry
namespace-module-registry$1)
(add-core-primitive! 'namespace? 1/namespace?)
(add-core-primitive!
'variable-reference->empty-namespace
1/variable-reference->empty-namespace)
(add-core-primitive!
'variable-reference->namespace
1/variable-reference->namespace)
(add-core-primitive!
'variable-reference->resolved-module-path
1/variable-reference->resolved-module-path)
(add-core-primitive!
'variable-reference->module-path-index
1/variable-reference->module-path-index)
(add-core-primitive!
'variable-reference->module-source
1/variable-reference->module-source)
(add-core-primitive!
'variable-reference->phase
1/variable-reference->phase)
(add-core-primitive!
'variable-reference->module-base-phase
1/variable-reference->module-base-phase)
(add-core-primitive!
'variable-reference->module-declaration-inspector
1/variable-reference->module-declaration-inspector)
(add-core-primitive! 'read-syntax 1/read-syntax)
(add-core-primitive! 'read-syntax/recursive 1/read-syntax/recursive)))
(void)))
(define declare-kernel-module!.1
(|#%name|
declare-kernel-module!
(lambda (main-ids1_0 read-ids2_0 ns5_0)
(begin
(begin
(let ((temp45_0
(set-union primitive-ids (set-union main-ids1_0 read-ids2_0))))
(let ((temp46_0
(hasheq
'variable-reference?
variable-reference?
'variable-reference-constant?
variable-reference-constant?
'variable-reference-from-unsafe?
variable-reference-from-unsafe?)))
(let ((temp45_1 temp45_0))
(copy-runtime-module!.1
hash2610
temp46_0
ns5_0
#t
#f
temp45_1
'|#%runtime|
'|#%kernel|))))
(let ((temp49_0 '(|#%core| |#%runtime| |#%main| |#%read|)))
(declare-reexporting-module!.1 ns5_0 #t '|#%kernel| temp49_0)))))))
(define copy-runtime-module!.1
(|#%name|
copy-runtime-module!
(lambda (alts10_0
extras11_0
namespace8_0
primitive?12_0
protected?13_0
skip9_0
to7_0
name21_0)
(begin
(let ((to-name_0 (if (eq? to7_0 unsafe-undefined) name21_0 to7_0)))
(let ((skip-syms_0
(if (eq? skip9_0 unsafe-undefined) (seteq) skip9_0)))
(let ((prims_0 (primitive-table name21_0)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(let ((sym_0 (hash-iterate-key prims_0 i_0)))
(begin
(begin-unsafe
(hash-set! built-in-symbols sym_0 #t))
(for-loop_0 (hash-iterate-next prims_0 i_0))))
(values)))))))
(for-loop_0 (hash-iterate-first prims_0))))
(let ((ht_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value prims_0 i_0))
(case-lambda
((sym_0 val_0)
(let ((table_1
(if (begin-unsafe
(hash-ref
skip-syms_0
sym_0
#f))
table_0
(let ((table_1
(call-with-values
(lambda ()
(values
sym_0
(let ((or-part_0
(hash-ref
alts10_0
sym_0
#f)))
(if or-part_0
or-part_0
val_0))))
(case-lambda
((key_0 val_1)
(hash-set
table_0
key_0
val_1))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1)))))
(for-loop_0
table_1
(hash-iterate-next prims_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_0))))))
(for-loop_0
hash2610
(hash-iterate-first prims_0))))))
(let ((ht+extras_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (ht_1 i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value extras11_0 i_0))
(case-lambda
((k_0 v_0)
(let ((ht_2
(let ((ht_2
(hash-set ht_1 k_0 v_0)))
(values ht_2))))
(for-loop_0
ht_2
(hash-iterate-next extras11_0 i_0))))
(args
(raise-binding-result-arity-error
2
args))))
ht_1))))))
(for-loop_0
ht_0
(hash-iterate-first extras11_0))))))
(declare-hash-based-module!.1
namespace8_0
primitive?12_0
null
protected?13_0
#f
to-name_0
ht+extras_0)))))))))))
(define declare-hash-based-module!.1
(|#%name|
declare-hash-based-module!
(lambda (namespace23_0
primitive?24_0
protected26_0
protected?25_0
register-builtin?27_0
name33_0
ht34_0)
(begin
(let ((mpi_0 (1/module-path-index-join (list 'quote name33_0) #f)))
(let ((temp57_0
(let ((temp62_0
(if (not protected?25_0) (null? protected26_0) #f)))
(let ((temp64_0
(hasheqv
0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((sym_0
(hash-iterate-key ht34_0 i_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda ()
(begin
(if register-builtin?27_0
(begin-unsafe
(hash-set!
built-in-symbols
sym_0
#t))
(void))
(let ((binding_0
(make-module-binding.1
#f
null
#f
#f
unsafe-undefined
unsafe-undefined
0
unsafe-undefined
mpi_0
0
sym_0)))
(values
sym_0
(if (if protected?25_0
protected?25_0
(member
sym_0
protected26_0))
(provided1.1
binding_0
#t
#f)
binding_0)))))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next ht34_0 i_0))))
table_0))))))
(for-loop_0
hash2725
(hash-iterate-first ht34_0)))))))
(let ((temp65_0
(lambda (data-box_0
ns_0
phase-shift_0
phase-level_0
self_0
bulk-binding-registry_0
insp_0)
(if (= 0 phase-level_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
ht34_0
i_0))
(case-lambda
((sym_0 val_0)
(begin
(namespace-set-variable!
ns_0
0
sym_0
val_0
#t)
(for-loop_0
(hash-iterate-next
ht34_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
(values)))))))
(for-loop_0 (hash-iterate-first ht34_0))))
(void))
(void)))))
(let ((temp64_1 temp64_0) (temp62_1 temp62_0))
(make-module.1
#t
void
unsafe-undefined
temp65_0
#f
0
0
temp62_1
unsafe-undefined
#t
void
primitive?24_0
temp64_1
null
mpi_0
#f
null
#f)))))))
(let ((temp58_0 (1/module-path-index-resolve mpi_0)))
(let ((temp57_1 temp57_0))
(declare-module!.1 #t namespace23_0 temp57_1 temp58_0)))))))))
(define declare-reexporting-module!.1
(|#%name|
declare-reexporting-module!
(lambda (namespace37_0 reexport?36_0 name40_0 require-names41_0)
(begin
(let ((mpi_0 (1/module-path-index-join (list 'quote name40_0) #f)))
(let ((require-mpis_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((require-name_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(1/module-path-index-join
(list 'quote require-name_0)
#f)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null require-names41_0))))))
(let ((temp75_0 (list (cons 0 require-mpis_0))))
(let ((temp70_0
(let ((temp76_0
(if reexport?36_0
(hasheqv
0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 lst_0)
(begin
(if (pair? lst_0)
(let ((require-mpi_0
(unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((table_1
(let ((m_0
(namespace->module
namespace37_0
(1/module-path-index-resolve
require-mpi_0))))
(begin
#t
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (table_1)
(begin
(let ((table_2
(let ((ht_0
(hash-ref
(shift-provides-module-path-index
(module-provides
m_0)
(module-self
m_0)
require-mpi_0)
0)))
(begin
(letrec*
((for-loop_2
(|#%name|
for-loop
(lambda (table_2
i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value
ht_0
i_0))
(case-lambda
((sym_0
binding_0)
(let ((table_3
(let ((table_3
(call-with-values
(lambda ()
(values
sym_0
binding_0))
(case-lambda
((key_0
val_0)
(hash-set
table_2
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
table_3))))
(for-loop_2
table_3
(hash-iterate-next
ht_0
i_0))))
(args
(raise-binding-result-arity-error
2
args))))
table_2))))))
(for-loop_2
table_1
(hash-iterate-first
ht_0)))))))
table_2))))))
(for-loop_1
table_0))))))
(for-loop_0 table_1 rest_0))))
table_0))))))
(for-loop_0 hash2725 require-mpis_0))))
hash2589)))
(let ((temp75_1 temp75_0))
(make-module.1
#t
void
unsafe-undefined
void
#f
0
0
#f
unsafe-undefined
#t
void
#f
temp76_0
temp75_1
mpi_0
#f
null
#f)))))
(let ((temp71_0 (1/module-path-index-resolve mpi_0)))
(let ((temp70_1 temp70_0))
(declare-module!.1
#t
namespace37_0
temp70_1
temp71_0)))))))))))
(define read-primitives
(hasheq
'read
1/read
'read/recursive
1/read/recursive
'read-language
1/read-language
'string->number
1/string->number
'current-reader-guard
1/current-reader-guard
'read-square-bracket-as-paren
1/read-square-bracket-as-paren
'read-curly-brace-as-paren
1/read-curly-brace-as-paren
'read-square-bracket-with-tag
1/read-square-bracket-with-tag
'read-curly-brace-with-tag
1/read-curly-brace-with-tag
'read-cdot
1/read-cdot
'read-accept-graph
1/read-accept-graph
'read-accept-compiled
1/read-accept-compiled
'read-accept-box
1/read-accept-box
'read-decimal-as-inexact
1/read-decimal-as-inexact
'read-single-flonum
1/read-single-flonum
'read-accept-dot
1/read-accept-dot
'read-accept-infix-dot
1/read-accept-infix-dot
'read-accept-quasiquote
1/read-accept-quasiquote
'read-accept-reader
1/read-accept-reader
'read-accept-lang
1/read-accept-lang
'current-readtable
1/current-readtable
'readtable?
1/readtable?
'make-readtable
1/make-readtable
'readtable-mapping
1/readtable-mapping
'special-comment?
1/special-comment?
'make-special-comment
1/make-special-comment
'special-comment-value
1/special-comment-value))
(define main-primitives
(hasheq
'eval
eval$1
'eval-syntax
1/eval-syntax
'compile
compile$1
'compile-syntax
1/compile-syntax
'expand
1/expand
'expand-syntax
1/expand-syntax
'expand-once
1/expand-once
'expand-syntax-once
1/expand-syntax-once
'expand-to-top-form
1/expand-to-top-form
'expand-syntax-to-top-form
1/expand-syntax-to-top-form
'dynamic-require
1/dynamic-require
'dynamic-require-for-syntax
1/dynamic-require-for-syntax
'load
1/load
'load-extension
1/load-extension
'load/use-compiled
1/load/use-compiled
'current-eval
1/current-eval
'current-compile
1/current-compile
'current-load
1/current-load
'current-load/use-compiled
1/current-load/use-compiled
'collection-path
1/collection-path
'collection-file-path
1/collection-file-path
'find-library-collection-paths
1/find-library-collection-paths
'find-library-collection-links
1/find-library-collection-links
'current-library-collection-paths
1/current-library-collection-paths
'current-library-collection-links
1/current-library-collection-links
'use-compiled-file-paths
1/use-compiled-file-paths
'current-compiled-file-roots
1/current-compiled-file-roots
'use-compiled-file-check
1/use-compiled-file-check
'use-collection-link-paths
1/use-collection-link-paths
'use-user-specific-search-paths
1/use-user-specific-search-paths
'compiled-expression?
1/compiled-expression?
'compiled-module-expression?
1/compiled-module-expression?
'module-compiled-name
1/module-compiled-name
'module-compiled-submodules
1/module-compiled-submodules
'module-compiled-language-info
1/module-compiled-language-info
'module-compiled-imports
1/module-compiled-imports
'module-compiled-exports
1/module-compiled-exports
'module-compiled-indirect-exports
1/module-compiled-indirect-exports
'compiled-expression-recompile
1/compiled-expression-recompile
'make-empty-namespace
1/make-empty-namespace
'namespace-attach-module
1/namespace-attach-module
'namespace-attach-module-declaration
1/namespace-attach-module-declaration
'namespace-symbol->identifier
1/namespace-symbol->identifier
'namespace-module-identifier
1/namespace-module-identifier
'namespace-syntax-introduce
1/namespace-syntax-introduce
'namespace-require
1/namespace-require
'namespace-require/copy
1/namespace-require/copy
'namespace-require/constant
1/namespace-require/constant
'namespace-require/expansion-time
1/namespace-require/expansion-time
'namespace-variable-value
1/namespace-variable-value
'namespace-set-variable-value!
1/namespace-set-variable-value!
'namespace-undefine-variable!
1/namespace-undefine-variable!
'namespace-mapped-symbols
1/namespace-mapped-symbols
'namespace-base-phase
1/namespace-base-phase
'module-declared?
1/module-declared?
'module-predefined?
1/module-predefined?
'module->language-info
1/module->language-info
'module->imports
1/module->imports
'module->exports
1/module->exports
'module->indirect-exports
1/module->indirect-exports
'module-compiled-cross-phase-persistent?
1/module-compiled-cross-phase-persistent?
'module-provide-protected?
1/module-provide-protected?
'module->namespace
1/module->namespace
'namespace-unprotect-module
1/namespace-unprotect-module))
(define utils-primitives
(hasheq
'path-string?
path-string?
'normal-case-path
normal-case-path
'path-replace-extension
path-replace-extension
'path-add-extension
path-add-extension
'reroot-path
reroot-path
'path-list-string->path-list
path-list-string->path-list
'find-executable-path
find-executable-path
'call-with-default-reading-parameterization
call-with-default-reading-parameterization
'collection-path
1/collection-path
'collection-file-path
1/collection-file-path
'find-library-collection-paths
1/find-library-collection-paths
'find-library-collection-links
1/find-library-collection-links
'load/use-compiled
1/load/use-compiled
'find-main-config
find-main-config
'find-main-collects
find-main-collects))
(define expobs-primitives
(hasheq
'current-expand-observe
current-expand-observe
'syntax-local-expand-observer
syntax-local-expand-observer))
(define-values
(struct:TH-place-channel
TH-place-channel
TH-place-channel?
TH-place-channel-ref
TH-place-channel-set!)
(make-struct-type
'TH-place-channel
#f
2
0
#f
(list (cons prop:evt (lambda (x_0) (|#%app| TH-place-channel-ref x_0 0))))))
(define TH-place-channel-in
(lambda (x_0) (|#%app| TH-place-channel-ref x_0 0)))
(define TH-place-channel-out
(lambda (x_0) (|#%app| TH-place-channel-ref x_0 1)))
(define place-struct-primitives
(hasheq
'struct:TH-place-channel
struct:TH-place-channel
'TH-place-channel
TH-place-channel
'TH-place-channel?
TH-place-channel?
'TH-place-channel-in
TH-place-channel-in
'TH-place-channel-out
TH-place-channel-out))
(define linklet-directory?
(lambda (v_0)
(let ((or-part_0 (linklet-directory?$1 v_0)))
(if or-part_0 or-part_0 (compiled-in-memory? v_0)))))
(define linklet-directory->hash
(lambda (ld_0)
(linklet-directory->hash$1
(if (compiled-in-memory? ld_0)
(compiled-in-memory-linklet-directory ld_0)
ld_0))))
(define linklet-primitives
(hasheq
'primitive-table
primitive-table
'primitive->compiled-position
primitive->compiled-position
'compiled-position->primitive
compiled-position->primitive
'primitive-in-category?
primitive-in-category?
'primitive-lookup
primitive-lookup
'linklet?
linklet?
'compile-linklet
compile-linklet
'recompile-linklet
recompile-linklet
'eval-linklet
eval-linklet
'instantiate-linklet
instantiate-linklet
'linklet-import-variables
linklet-import-variables
'linklet-export-variables
linklet-export-variables
'instance?
instance?
'make-instance
make-instance
'instance-name
instance-name
'instance-data
instance-data
'instance-variable-names
instance-variable-names
'instance-variable-value
instance-variable-value
'instance-set-variable-value!
instance-set-variable-value!
'instance-unset-variable!
instance-unset-variable!
'instance-describe-variable!
instance-describe-variable!
'linklet-virtual-machine-bytes
linklet-virtual-machine-bytes
'write-linklet-bundle-hash
write-linklet-bundle-hash
'read-linklet-bundle-hash
read-linklet-bundle-hash
'variable-reference?
variable-reference?
'variable-reference->instance
variable-reference->instance
'variable-reference-constant?
variable-reference-constant?
'variable-reference-from-unsafe?
variable-reference-from-unsafe?))
(define linklet-expander-primitives
(hasheq
'linklet-directory?
linklet-directory?
'linklet-directory->hash
linklet-directory->hash
'hash->linklet-directory
hash->linklet-directory
'linklet-bundle?
linklet-bundle?
'linklet-bundle->hash
linklet-bundle->hash
'hash->linklet-bundle
hash->linklet-bundle))
(define with-module-reading-parameterization
(lambda (thunk_0)
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/read-accept-reader
#t
1/read-accept-lang
#t
1/read-accept-compiled
#t
read-case-sensitive
#t
1/read-square-bracket-as-paren
#t
1/read-curly-brace-as-paren
#t
1/read-square-bracket-with-tag
#f
1/read-curly-brace-with-tag
#f
1/read-accept-box
#t
read-accept-bar-quote
#t
1/read-accept-graph
#t
1/read-decimal-as-inexact
#t
1/read-cdot
#f
1/read-accept-dot
#t
1/read-accept-infix-dot
#t
1/read-accept-quasiquote
#t
1/current-readtable
#f)
(|#%app| thunk_0))))
(define check-module-form
(lambda (exp_0 filename_0)
(if (let ((or-part_0 (eof-object? exp_0)))
(if or-part_0 or-part_0 (eof-object? (1/syntax-e exp_0))))
(if filename_0
(error
'load-handler
(string-append
"expected a `module' declaration, but found end-of-file\n"
" file: ~a")
filename_0)
#f)
(if (1/compiled-module-expression? (1/syntax-e exp_0))
exp_0
(if (if (syntax?$1 exp_0)
(if (pair? (1/syntax-e exp_0))
(if (eq? 'module (1/syntax-e (car (1/syntax-e exp_0))))
(let ((r_0 (cdr (1/syntax-e exp_0))))
(let ((r_1 (if (syntax?$1 r_0) (1/syntax-e r_0) r_0)))
(if (pair? r_1) (identifier? (car r_1)) #f)))
#f)
#f)
#f)
(1/datum->syntax
exp_0
(let ((app_0 (1/namespace-module-identifier)))
(cons app_0 (cdr (1/syntax-e exp_0))))
exp_0
exp_0)
(if filename_0
(error
'default-load-handler
(string-append
"expected a `module' declaration, but found something else\n"
" file: ~a")
filename_0)
#f))))))
(define default-load-handler
(lambda (path_0 expected-mod_0)
(begin
(if (path-string? path_0)
(void)
(raise-argument-error 'default-load-handler "path-string?" path_0))
(begin
(if (let ((or-part_0 (not expected-mod_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (symbol? expected-mod_0)))
(if or-part_1
or-part_1
(if (pair? expected-mod_0)
(if (list? expected-mod_0)
(if (let ((or-part_2 (not (car expected-mod_0))))
(if or-part_2
or-part_2
(symbol? (car expected-mod_0))))
(andmap_2344 symbol? (cdr expected-mod_0))
#f)
#f)
#f)))))
(void)
(raise-argument-error
'default-load-handler
"(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))"
expected-mod_0))
(let ((maybe-count-lines!_0
(|#%name|
maybe-count-lines!
(lambda (i_0)
(begin
(if (regexp-match? rx2937 path_0)
(void)
(port-count-lines! i_0)))))))
(if expected-mod_0
(|#%app|
(call-with-input-module-file
path_0
(lambda (i_0)
(begin
(maybe-count-lines!_0 i_0)
(with-module-reading-parameterization+delay-source
path_0
(lambda ()
(let ((c2_0 (linklet-directory-start i_0)))
(if c2_0
(let ((b-pos_0
(search-directory
i_0
c2_0
(encode-symbols expected-mod_0))))
(if b-pos_0
(begin
(file-position i_0 b-pos_0)
(let ((or-part_0 (cached-bundle i_0)))
(if or-part_0
or-part_0
(let ((v_0 (1/read i_0)))
(if (1/compiled-module-expression? v_0)
(lambda ()
(|#%app| (1/current-eval) v_0))
(let ((app_0
(string-append
"expected a compiled module\n"
" in: ~e\n"
" found: ~e")))
(error
'default-load-handler
app_0
(object-name i_0)
v_0)))))))
(if (pair? expected-mod_0)
void
(let ((app_0
(string-append
"could not find main module\n"
" in: ~e")))
(error
'default-load-handler
app_0
(object-name i_0))))))
(if (if (pair? expected-mod_0)
(not (car expected-mod_0))
#f)
void
(let ((c1_0 (cached-bundle i_0)))
(if c1_0
c1_0
(let ((s_0
(1/read-syntax (object-name i_0) i_0)))
(begin
(if (eof-object? s_0)
(let ((app_0
(string-append
"expected a `module' declaration;\n"
" found end-of-file\n"
" in: ~e")))
(error
'default-load-handler
app_0
(object-name i_0)))
(void))
(let ((m-s_0
(check-module-form s_0 path_0)))
(let ((s2_0
(1/read-syntax
(object-name i_0)
i_0)))
(begin
(if (eof-object? s2_0)
(void)
(let ((app_0
(string-append
"expected a `module' declaration;\n"
" found an extra form\n"
" in: ~e\n"
" found: ~.s")))
(error
'default-load-handler
app_0
(object-name i_0)
s2_0)))
(lambda ()
(|#%app|
(1/current-eval)
m-s_0))))))))))))))))))
(let ((add-top-interaction_0
(|#%name|
add-top-interaction
(lambda (s_0)
(begin
(1/namespace-syntax-introduce
(1/datum->syntax
#f
(cons '|#%top-interaction| s_0)
s_0)))))))
(let ((temp2_0
(|#%name|
temp2
(lambda (i_0)
(begin
(begin
(maybe-count-lines!_0 i_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (vals_0)
(begin
(let ((s_0
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/read-accept-compiled
#t
1/read-accept-reader
#t
1/read-accept-lang
#t)
(if (load-on-demand-enabled)
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
read-on-demand-source
(path->complete-path
path_0)))
(1/read-syntax
(object-name i_0)
i_0))
(1/read-syntax
(object-name i_0)
i_0)))))
(if (eof-object? s_0)
(apply values vals_0)
(loop_0
(call-with-continuation-prompt
(lambda ()
(call-with-values
(lambda ()
(let ((app_0 (1/current-eval)))
(|#%app|
app_0
(add-top-interaction_0
s_0))))
list))
(default-continuation-prompt-tag)
(lambda args_0
(apply
abort-current-continuation
(default-continuation-prompt-tag)
args_0)))))))))))
(loop_0 (list (void))))))))))
(call-with-input-file*.1 'binary path_0 temp2_0)))))))))
(define version-bytes (string->bytes/utf-8 (version)))
(define version-length (unsafe-bytes-length version-bytes))
(define vm-bytes (string->bytes/utf-8 (symbol->string (system-type 'vm))))
(define vm-length (unsafe-bytes-length vm-bytes))
(define linklet-bundle-or-directory-start
(lambda (i_0 tag_0)
(let ((version-length_0 (string-length (version))))
(let ((vm-length_0 (string-length (symbol->string (system-type 'vm)))))
(if (eq? (peek-byte i_0) 35)
(if (eq? (peek-byte i_0 1) 126)
(if (equal? (peek-byte i_0 2) version-length_0)
(if (equal? (peek-bytes version-length_0 3 i_0) version-bytes)
(if (equal? (peek-byte i_0 (+ 3 version-length_0)) vm-length_0)
(if (equal?
(peek-bytes vm-length_0 (+ 4 version-length_0) i_0)
vm-bytes)
(if (let ((app_0
(peek-byte
i_0
(+ 4 version-length_0 vm-length_0))))
(equal? app_0 (char->integer tag_0)))
(+ version-length_0 vm-length_0 5)
#f)
#f)
#f)
#f)
#f)
#f)
#f)))))
(define linklet-directory-start
(lambda (i_0)
(let ((pos_0 (linklet-bundle-or-directory-start i_0 '#\x44)))
(if pos_0 (+ pos_0 4) #f))))
(define linklet-bundle-hash-code
(lambda (i_0)
(let ((pos_0 (linklet-bundle-or-directory-start i_0 '#\x42)))
(let ((hash-code_0 (if pos_0 (peek-bytes 20 pos_0 i_0) #f)))
(if (bytes? hash-code_0)
(if (= 20 (unsafe-bytes-length hash-code_0))
(if (call-with-values
(lambda ()
(begin
(check-bytes hash-code_0)
(values hash-code_0 (unsafe-bytes-length hash-code_0))))
(case-lambda
((vec_0 len_0)
(begin
#f
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (result_0 pos_1)
(begin
(if (unsafe-fx< pos_1 len_0)
(let ((c_0 (unsafe-bytes-ref vec_0 pos_1)))
(let ((result_1 (not (eq? c_0 0))))
(let ((result_2 (values result_1)))
(if (if (not
(let ((x_0 (list c_0)))
result_2))
#t
#f)
(for-loop_0
result_2
(unsafe-fx+ 1 pos_1))
result_2))))
result_0))))))
(for-loop_0 #f 0))))
(args (raise-binding-result-arity-error 2 args))))
hash-code_0
#f)
#f)
#f)))))
(define cached-bundle
(lambda (i_0)
(let ((c3_0
(module-cache-ref
(make-module-cache-key (linklet-bundle-hash-code i_0)))))
(if c3_0 (lambda () (|#%app| c3_0 (1/current-namespace))) #f))))
(define read-number
(lambda (i_0)
(let ((read-byte/not-eof_0
(|#%name|
read-byte/not-eof
(lambda (i_1)
(begin
(let ((v_0 (read-byte i_1))) (if (eof-object? v_0) 0 v_0)))))))
(let ((app_0 (read-byte/not-eof_0 i_0)))
(let ((app_1 (arithmetic-shift (read-byte/not-eof_0 i_0) 8)))
(let ((app_2 (arithmetic-shift (read-byte/not-eof_0 i_0) 16)))
(bitwise-ior
app_0
app_1
app_2
(arithmetic-shift (read-byte/not-eof_0 i_0) 24))))))))
(define search-directory
(lambda (i_0 pos_0 bstr_0)
(if (zero? pos_0)
#f
(begin
(file-position i_0 pos_0)
(let ((name-len_0 (read-number i_0)))
(let ((v_0 (read-bytes name-len_0 i_0)))
(begin
(if (if (bytes? v_0) (= (unsafe-bytes-length v_0) name-len_0) #f)
(void)
(let ((app_0
(string-append
"failure getting submodule path\n"
" in: ~e\n"
" at position: ~a\n"
" expected bytes: ~a\n"
" read bytes: ~e")))
(error
'deafult-load-handler
app_0
(object-name i_0)
pos_0
name-len_0
v_0)))
(if (bytes=? bstr_0 v_0)
(read-number i_0)
(if (bytes<? bstr_0 v_0)
(begin
(read-number i_0)
(read-number i_0)
(search-directory i_0 (read-number i_0) bstr_0))
(begin
(read-number i_0)
(read-number i_0)
(read-number i_0)
(search-directory i_0 (read-number i_0) bstr_0)))))))))))
(define encode-symbols
(lambda (expected-mod_0)
(if (symbol? expected-mod_0)
#vu8()
(apply
bytes-append
(reverse$1
(let ((lst_0 (cdr expected-mod_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((s_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((bstr_0
(string->bytes/utf-8
(symbol->string s_0))))
(let ((len_0
(unsafe-bytes-length
bstr_0)))
(if (< len_0 255)
(bytes-append
(bytes len_0)
bstr_0)
(bytes-append
255
(integer->integer-bytes
len_0
4
#f
#f)
bstr_0))))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))))
(define with-module-reading-parameterization+delay-source
(lambda (path_0 thunk_0)
(if (load-on-demand-enabled)
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0 (continuation-mark-set-first #f parameterization-key)))
(extend-parameterization
app_0
read-on-demand-source
(path->complete-path path_0)))
(with-module-reading-parameterization thunk_0))
(with-module-reading-parameterization thunk_0))))
(define call-with-input-module-file
(lambda (path_0 proc_0)
(let ((i_0 #f))
(dynamic-wind
(lambda () (set! i_0 (open-input-file.1 #t 'binary path_0)))
(lambda () (|#%app| proc_0 i_0))
(lambda () (close-input-port i_0))))))
(define dll-suffix (system-type 'so-suffix))
(define default-load/use-compiled
(let ((resolve_0
(|#%name|
resolve
(lambda (s_0)
(begin
(if (complete-path? s_0)
s_0
(let ((d_0 (current-load-relative-directory)))
(if d_0 (path->complete-path s_0 d_0) s_0))))))))
(let ((date-of-1_0
(|#%name|
date-of-1
(lambda (a_0)
(begin
(let ((v_0
(file-or-directory-modify-seconds
a_0
#f
(lambda () #f))))
(if v_0 (cons a_0 v_0) #f)))))))
(let ((date-of_0
(|#%name|
date-of
(lambda (a_0 modes_0 roots_0)
(begin
(ormap_2765
(lambda (root-dir_0)
(ormap_2765
(lambda (compiled-dir_0)
(let ((a_1 (|#%app| a_0 root-dir_0 compiled-dir_0)))
(date-of-1_0 a_1)))
modes_0))
roots_0))))))
(let ((date>=?_0
(|#%name|
date>=?
(lambda (modes_0 roots_0 a_0 bm_0)
(begin
(if a_0
(let ((am_0 (date-of_0 a_0 modes_0 roots_0)))
(let ((or-part_0 (if (not bm_0) am_0 #f)))
(if or-part_0
or-part_0
(if am_0
(if bm_0
(if (let ((app_0 (cdr am_0)))
(>= app_0 (cdr bm_0)))
am_0
#f)
#f)
#f))))
#f))))))
(let ((with-dir*_0
(|#%name|
with-dir*
(lambda (base_0 t_0)
(begin
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
current-load-relative-directory
(if (path? base_0) base_0 (current-directory))))
(|#%app| t_0)))))))
(lambda (path_0 expect-module_0)
(begin
(if (path-string? path_0)
(void)
(raise-argument-error
'load/use-compiled
"path-string?"
path_0))
(begin
(if (let ((or-part_0 (not expect-module_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (symbol? expect-module_0)))
(if or-part_1
or-part_1
(if (list? expect-module_0)
(if (> (length expect-module_0) 1)
(if (let ((or-part_2
(symbol? (car expect-module_0))))
(if or-part_2
or-part_2
(not (car expect-module_0))))
(andmap_2344 symbol? (cdr expect-module_0))
#f)
#f)
#f)))))
(void)
(raise-argument-error
'load/use-compiled
"(or/c #f symbol? (cons/c (or/c #f symbol?) (non-empty-listof symbol?)))"
path_0))
(let ((name_0
(if expect-module_0
(1/current-module-declare-name)
#f)))
(let ((ns-hts_0
(if name_0
(registry-table-ref
(namespace-module-registry$1
(1/current-namespace)))
#f)))
(let ((use-path/src_0
(if ns-hts_0
(hash-ref (cdr ns-hts_0) name_0 #f)
#f)))
(if use-path/src_0
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
1/current-module-declare-source
(cadr use-path/src_0)))
(with-dir*_0
(caddr use-path/src_0)
(lambda ()
(let ((app_0 (1/current-load)))
(|#%app|
app_0
(car use-path/src_0)
expect-module_0)))))
(let ((orig-path_0 (resolve_0 path_0)))
(call-with-values
(lambda () (split-path path_0))
(case-lambda
((base_0 orig-file_0 dir?_0)
(call-with-values
(lambda ()
(if expect-module_0
(let ((b_0 (path->bytes orig-file_0)))
(let ((len_0 (unsafe-bytes-length b_0)))
(if (if (>= len_0 4)
(bytes=?
#vu8(46 114 107 116)
(subbytes b_0 (- len_0 4)))
#f)
(values
orig-file_0
(bytes->path
(bytes-append
(subbytes b_0 0 (- len_0 4))
#vu8(46 115 115))))
(values orig-file_0 #f))))
(values orig-file_0 #f)))
(case-lambda
((file_0 alt-file_0)
(let ((path_1
(if (eq? file_0 orig-file_0)
orig-path_0
(build-path base_0 file_0))))
(let ((alt-path_0
(if alt-file_0
(if (eq? alt-file_0 orig-file_0)
orig-path_0
(build-path base_0 alt-file_0))
#f)))
(let ((base_1
(if (eq? base_0 'relative)
'same
base_0)))
(let ((modes_0
(1/use-compiled-file-paths)))
(let ((roots_0
(1/current-compiled-file-roots)))
(let ((reroot_0
(|#%name|
reroot
(lambda (p_0 d_0)
(begin
(if (eq? d_0 'same)
p_0
(if (relative-path?
d_0)
(build-path
p_0
d_0)
(reroot-path
p_0
d_0))))))))
(let ((main-path-d_0
(date-of-1_0 path_1)))
(let ((alt-path-d_0
(if alt-path_0
(if (not
main-path-d_0)
(date-of-1_0
alt-path_0)
#f)
#f)))
(let ((path-d_0
(if main-path-d_0
main-path-d_0
alt-path-d_0)))
(let ((get-so_0
(|#%name|
get-so
(lambda (file_1
rep-sfx?_0)
(begin
(if (eq?
'racket
(system-type
'vm))
(lambda (root-dir_0
compiled-dir_0)
(let ((app_0
(reroot_0
base_1
root-dir_0)))
(let ((app_1
(system-library-subpath)))
(build-path
app_0
compiled-dir_0
"native"
app_1
(if rep-sfx?_0
(begin-unsafe
(path-adjust-extension
'path-add-extension
#vu8(95)
subbytes
file_1
dll-suffix
#t))
file_1)))))
#f))))))
(let ((zo_0
(|#%name|
zo
(lambda (root-dir_0
compiled-dir_0)
(begin
(let ((app_0
(reroot_0
base_1
root-dir_0)))
(build-path
app_0
compiled-dir_0
(let ((sfx_0
#vu8(46 122 111)))
(begin-unsafe
(path-adjust-extension
'path-add-extension
#vu8(95)
subbytes
file_0
sfx_0
#t))))))))))
(let ((alt-zo_0
(|#%name|
alt-zo
(lambda (root-dir_0
compiled-dir_0)
(begin
(let ((app_0
(reroot_0
base_1
root-dir_0)))
(build-path
app_0
compiled-dir_0
(let ((sfx_0
#vu8(46 122 111)))
(begin-unsafe
(path-adjust-extension
'path-add-extension
#vu8(95)
subbytes
alt-file_0
sfx_0
#t))))))))))
(let ((so_0
(get-so_0
file_0
#t)))
(let ((alt-so_0
(get-so_0
alt-file_0
#t)))
(let ((try-main?_0
(if main-path-d_0
main-path-d_0
(not
alt-path-d_0))))
(let ((try-alt?_0
(if alt-file_0
(if alt-path-d_0
alt-path-d_0
(not
main-path-d_0))
#f)))
(let ((with-dir_0
(|#%name|
with-dir
(lambda (t_0)
(begin
(with-dir*_0
base_1
t_0))))))
(let ((c4_0
(if so_0
(if try-main?_0
(date>=?_0
modes_0
roots_0
so_0
path-d_0)
#f)
#f)))
(if c4_0
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-module-declare-source
#f)
(let ((t_0
(lambda ()
(let ((app_0
(current-load-extension)))
(|#%app|
app_0
(car
c4_0)
expect-module_0)))))
(begin-unsafe
(begin
(with-dir*_0
base_1
t_0)))))
(let ((c3_0
(if alt-so_0
(if try-alt?_0
(date>=?_0
modes_0
roots_0
alt-so_0
alt-path-d_0)
#f)
#f)))
(if c3_0
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-module-declare-source
alt-path_0)
(let ((t_0
(lambda ()
(let ((app_0
(current-load-extension)))
(|#%app|
app_0
(car
c3_0)
expect-module_0)))))
(begin-unsafe
(begin
(with-dir*_0
base_1
t_0)))))
(let ((c2_0
(if try-main?_0
(date>=?_0
modes_0
roots_0
zo_0
path-d_0)
#f)))
(if c2_0
(begin
(register-zo-path
name_0
ns-hts_0
(car
c2_0)
#f
base_1)
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-module-declare-source
#f)
(let ((t_0
(lambda ()
(let ((app_0
(1/current-load)))
(|#%app|
app_0
(car
c2_0)
expect-module_0)))))
(begin-unsafe
(begin
(with-dir*_0
base_1
t_0))))))
(let ((c1_0
(if try-alt?_0
(date>=?_0
modes_0
roots_0
alt-zo_0
path-d_0)
#f)))
(if c1_0
(begin
(register-zo-path
name_0
ns-hts_0
(car
c1_0)
alt-path_0
base_1)
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-module-declare-source
alt-path_0)
(let ((t_0
(lambda ()
(let ((app_0
(1/current-load)))
(|#%app|
app_0
(car
c1_0)
expect-module_0)))))
(begin-unsafe
(begin
(with-dir*_0
base_1
t_0))))))
(if (let ((or-part_0
(not
(pair?
expect-module_0))))
(if or-part_0
or-part_0
(car
expect-module_0)))
(let ((p_0
(if try-main?_0
path_1
alt-path_0)))
(if (if (pair?
expect-module_0)
(not
(file-exists?
p_0))
#f)
(void)
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
1/current-module-declare-source
(if expect-module_0
(if (not
try-main?_0)
p_0
#f)
#f)))
(let ((t_0
(lambda ()
(|#%app|
(1/current-load)
p_0
expect-module_0))))
(begin-unsafe
(begin
(with-dir*_0
base_1
t_0)))))))
(void))))))))))))))))))))))))))))
(args
(raise-binding-result-arity-error 2 args)))))
(args
(raise-binding-result-arity-error
3
args))))))))))))))))))
(define register-zo-path
(lambda (name_0 ns-hts_0 path_0 src-path_0 base_0)
(if ns-hts_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)))
(define registry-table-ref
(lambda (reg_0)
(let ((e_0 (hash-ref (unsafe-place-local-ref cell.1) reg_0 #f)))
(if e_0 (ephemeron-value e_0) #f))))
(define registry-table-set!
(lambda (reg_0 v_0)
(hash-set!
(unsafe-place-local-ref cell.1)
reg_0
(make-ephemeron reg_0 v_0))))
(define cell.2 (unsafe-make-place-local (make-weak-hasheq)))
(define path-cache-get
(lambda (p_0 reg_0)
(let ((cache_0
(hash-ref (unsafe-place-local-ref cell.2) reg_0 hash2725)))
(hash-ref cache_0 p_0 #f))))
(define path-cache-set!
(lambda (p_0 reg_0 v_0)
(let ((current-cache_0
(hash-ref (unsafe-place-local-ref cell.2) reg_0 hash2725)))
(let ((cache_0
(if (= (hash-count current-cache_0) 1024)
hash2725
current-cache_0)))
(hash-set!
(unsafe-place-local-ref cell.2)
reg_0
(hash-set cache_0 p_0 v_0))))))
(define -loading-filename (gensym))
(define -loading-prompt-tag (make-continuation-prompt-tag 'module-loading))
(define cell.3 (unsafe-make-place-local #f))
(define cell.4 (unsafe-make-place-local #f))
(define split-relative-string
(lambda (s_0 coll-mode?_0)
(let ((l_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (s_1)
(begin
(let ((len_0 (string-length s_1)))
(letrec*
((iloop_0
(|#%name|
iloop
(lambda (i_0)
(begin
(if (= i_0 len_0)
(list s_1)
(if (char=? '#\x2f (string-ref s_1 i_0))
(let ((app_0 (substring s_1 0 i_0)))
(cons
app_0
(loop_0 (substring s_1 (add1 i_0)))))
(iloop_0 (add1 i_0)))))))))
(iloop_0 0))))))))
(loop_0 s_0))))
(if coll-mode?_0
l_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_1)
(begin
(if (null? (cdr l_1))
(values null (car l_1))
(call-with-values
(lambda () (loop_0 (cdr l_1)))
(case-lambda
((c_0 f_0) (values (cons (car l_1) c_0) f_0))
(args (raise-binding-result-arity-error 2 args))))))))))
(loop_0 l_0))))))
(define format-source-location
(lambda (stx_0)
(srcloc->string
(let ((app_0 (1/syntax-source stx_0)))
(let ((app_1 (1/syntax-line stx_0)))
(let ((app_2 (1/syntax-column stx_0)))
(let ((app_3 (1/syntax-position stx_0)))
(unsafe-make-srcloc
app_0
app_1
app_2
app_3
(1/syntax-span stx_0)))))))))
(define cell.5 (unsafe-make-place-local #f))
(define cell.6 (unsafe-make-place-local #f))
(define prep-planet-resolver!
(lambda ()
(if (unsafe-place-local-ref cell.6)
(void)
(with-continuation-mark*
authentic
parameterization-key
(unsafe-place-local-ref cell.5)
(unsafe-place-local-set!
cell.6
(1/dynamic-require
'(lib "planet/resolver.rkt")
'planet-module-name-resolver))))))
(define standard-module-name-resolver
(case-lambda
((s_0 from-namespace_0)
(begin
(if (1/resolved-module-path? s_0)
(void)
(raise-argument-error
'standard-module-name-resolver
"resolved-module-path?"
s_0))
(if (let ((or-part_0 (not from-namespace_0)))
(if or-part_0 or-part_0 (1/namespace? from-namespace_0)))
(void)
(raise-argument-error
'standard-module-name-resolver
"(or/c #f namespace?)"
from-namespace_0))
(if (unsafe-place-local-ref cell.6)
(|#%app| (unsafe-place-local-ref cell.6) s_0)
(void))
(let ((hts_0
(let ((or-part_0
(registry-table-ref
(namespace-module-registry$1 (1/current-namespace)))))
(if or-part_0
or-part_0
(let ((hts_0
(let ((app_0 (make-hasheq)))
(cons app_0 (make-hasheq)))))
(begin
(registry-table-set!
(namespace-module-registry$1 (1/current-namespace))
hts_0)
hts_0))))))
(begin
(hash-set! (car hts_0) s_0 'declared)
(if from-namespace_0
(let ((root-name_0
(if (pair? (1/resolved-module-path-name s_0))
(1/make-resolved-module-path
(car (1/resolved-module-path-name s_0)))
s_0)))
(let ((from-hts_0
(registry-table-ref
(namespace-module-registry$1 from-namespace_0))))
(let ((root-name_1 root-name_0))
(if from-hts_0
(let ((use-path/src_0
(hash-ref (cdr from-hts_0) root-name_1 #f)))
(if use-path/src_0
(hash-set! (cdr hts_0) root-name_1 use-path/src_0)
(void)))
(void)))))
(void))))))
((s_0 relto_0 stx_0)
(begin
(log-message
(current-logger)
'error
"default module name resolver called with three arguments (deprecated)"
#f)
(standard-module-name-resolver s_0 relto_0 stx_0 #t)))
((s_0 relto_0 stx_0 load?_0)
(begin
(if (1/module-path? s_0)
(void)
(if (syntax?$1 stx_0)
(raise-syntax-error$1 #f "bad module path" stx_0)
(raise-argument-error
'standard-module-name-resolver
"module-path?"
s_0)))
(begin
(if (let ((or-part_0 (not relto_0)))
(if or-part_0 or-part_0 (1/resolved-module-path? relto_0)))
(void)
(raise-argument-error
'standard-module-name-resolver
"(or/c #f resolved-module-path?)"
relto_0))
(begin
(if (let ((or-part_0 (not stx_0)))
(if or-part_0 or-part_0 (syntax?$1 stx_0)))
(void)
(raise-argument-error
'standard-module-name-resolver
"(or/c #f syntax?)"
stx_0))
(let ((flatten-sub-path_0
(|#%name|
flatten-sub-path
(lambda (base_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (a_0 l_0)
(begin
(if (null? l_0)
(if (null? a_0)
base_0
(cons base_0 (reverse$1 a_0)))
(if (equal? (car l_0) "..")
(if (null? a_0)
(error
'standard-module-name-resolver
"too many \"..\"s in submodule path: ~.s"
(list*
'submod
(if (equal? base_0 ".")
base_0
(if (path? base_0)
base_0
(list
(if (symbol? base_0) 'quote 'file)
base_0)))
orig-l_0))
(let ((app_0 (cdr a_0)))
(loop_0 app_0 (cdr l_0))))
(let ((app_0 (cons (car l_0) a_0)))
(loop_0 app_0 (cdr l_0))))))))))
(loop_0 null orig-l_0)))))))
(if (if (pair? s_0) (eq? (car s_0) 'quote) #f)
(1/make-resolved-module-path (cadr s_0))
(if (if (pair? s_0)
(if (eq? (car s_0) 'submod)
(if (pair? (cadr s_0)) (eq? (caadr s_0) 'quote) #f)
#f)
#f)
(1/make-resolved-module-path
(let ((app_0 (cadadr s_0)))
(flatten-sub-path_0 app_0 (cddr s_0))))
(if (if (pair? s_0)
(if (eq? (car s_0) 'submod)
(if (let ((or-part_0 (equal? (cadr s_0) ".")))
(if or-part_0
or-part_0
(equal? (cadr s_0) "..")))
(if relto_0
(let ((p_0 (1/resolved-module-path-name relto_0)))
(let ((or-part_0 (symbol? p_0)))
(if or-part_0
or-part_0
(if (pair? p_0) (symbol? (car p_0)) #f))))
#f)
#f)
#f)
#f)
(let ((rp_0 (1/resolved-module-path-name relto_0)))
(1/make-resolved-module-path
(let ((app_0 (if (pair? rp_0) (car rp_0) rp_0)))
(flatten-sub-path_0
app_0
(let ((r_0
(if (equal? (cadr s_0) "..")
(cdr s_0)
(cddr s_0))))
(if (pair? rp_0) (append (cdr rp_0) r_0) r_0))))))
(if (if (pair? s_0) (eq? (car s_0) 'planet) #f)
(begin
(prep-planet-resolver!)
(|#%app|
(unsafe-place-local-ref cell.6)
s_0
relto_0
stx_0
load?_0
#f
(unsafe-place-local-ref cell.5)))
(if (if (pair? s_0)
(if (eq? (car s_0) 'submod)
(if (pair? (cadr s_0))
(eq? (caadr s_0) 'planet)
#f)
#f)
#f)
(begin
(prep-planet-resolver!)
(let ((app_0 (cadr s_0)))
(|#%app|
(unsafe-place-local-ref cell.6)
app_0
relto_0
stx_0
load?_0
(cddr s_0)
(unsafe-place-local-ref cell.5))))
(let ((get-dir_0
(|#%name|
get-dir
(lambda ()
(begin
(let ((or-part_0
(if relto_0
(if (eq?
relto_0
(unsafe-place-local-ref
cell.3))
(unsafe-place-local-ref cell.4)
(let ((p_0
(1/resolved-module-path-name
relto_0)))
(let ((p_1
(if (pair? p_0)
(car p_0)
p_0)))
(if (path? p_1)
(call-with-values
(lambda ()
(split-path p_1))
(case-lambda
((base_0 n_0 d?_0)
(begin
(unsafe-place-local-set!
cell.3
relto_0)
(unsafe-place-local-set!
cell.4
base_0)
base_0))
(args
(raise-binding-result-arity-error
3
args))))
#f))))
#f)))
(if or-part_0
or-part_0
(let ((or-part_1
(current-load-relative-directory)))
(if or-part_1
or-part_1
(current-directory))))))))))
(let ((get-reg_0
(|#%name|
get-reg
(lambda ()
(begin
(namespace-module-registry$1
(1/current-namespace)))))))
(let ((show-collection-err_0
(|#%name|
show-collection-err
(lambda (msg_0)
(begin
(let ((msg_1
(let ((app_0
(let ((or-part_0
(if stx_0
(if (error-print-source-location)
(format-source-location
stx_0)
#f)
#f)))
(if or-part_0
or-part_0
"standard-module-name-resolver"))))
(string-append
app_0
": "
(regexp-replace
rx2823
msg_0
(format
"\n for module path: ~s\n"
s_0))))))
(raise
(if stx_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
(current-continuation-marks)
s_0)))))))))
(let ((invent-collection-dir_0
(|#%name|
invent-collection-dir
(lambda (f-file_0 col_0 col-path_0 fail_0)
(begin
(lambda (msg_0)
(string->uninterned-symbol
(path->string
(build-path
(apply
build-path
col_0
col-path_0)
f-file_0)))))))))
(let ((ss->rkt_0
(|#%name|
ss->rkt
(lambda (s_1)
(begin
(let ((len_0 (string-length s_1)))
(if (if (>= len_0 3)
(if (eqv?
'#\x2e
(string-ref
s_1
(- len_0 3)))
(if (eqv?
'#\x73
(string-ref
s_1
(- len_0 2)))
(eqv?
'#\x73
(string-ref
s_1
(- len_0 1)))
#f)
#f)
#f)
(string-append
(substring s_1 0 (- len_0 3))
".rkt")
s_1)))))))
(let ((path-ss->rkt_0
(|#%name|
path-ss->rkt
(lambda (p_0)
(begin
(call-with-values
(lambda () (split-path p_0))
(case-lambda
((base_0 name_0 dir?_0)
(if (regexp-match
rx2418
(path->bytes name_0))
(path-replace-extension
p_0
#vu8(46 114 107 116))
p_0))
(args
(raise-binding-result-arity-error
3
args)))))))))
(let ((s_1
(if (if (pair? s_0)
(eq? 'submod (car s_0))
#f)
(let ((v_0 (cadr s_0)))
(if (let ((or-part_0
(equal? v_0 ".")))
(if or-part_0
or-part_0
(equal? v_0 "..")))
(if relto_0
(let ((p_0
(1/resolved-module-path-name
relto_0)))
(if (pair? p_0)
(car p_0)
p_0))
(error
'standard-module-name-resolver
"no base path for relative submodule path: ~.s"
s_0))
v_0))
s_0)))
(let ((subm-path_0
(if (if (pair? s_0)
(eq? 'submod (car s_0))
#f)
(let ((p_0
(if (if (let ((or-part_0
(equal?
(cadr s_0)
".")))
(if or-part_0
or-part_0
(equal?
(cadr s_0)
"..")))
relto_0
#f)
(let ((p_0
(1/resolved-module-path-name
relto_0)))
(let ((r_0
(if (equal?
(cadr s_0)
"..")
(cdr s_0)
(cddr s_0))))
(let ((p_1 p_0))
(if (pair? p_1)
(let ((app_0
(car
p_1)))
(flatten-sub-path_0
app_0
(append
(cdr p_1)
r_0)))
(flatten-sub-path_0
p_1
r_0)))))
(flatten-sub-path_0
"."
(if (equal?
(cadr s_0)
"..")
(cdr s_0)
(cddr s_0))))))
(if (pair? p_0) (cdr p_0) #f))
#f)))
(let ((s_2 s_1)
(path-ss->rkt_1 path-ss->rkt_0)
(ss->rkt_1 ss->rkt_0)
(invent-collection-dir_1
invent-collection-dir_0)
(show-collection-err_1
show-collection-err_0)
(get-reg_1 get-reg_0)
(get-dir_1 get-dir_0))
(let ((s-parsed_0
(if (symbol? s_2)
(let ((or-part_0
(path-cache-get
s_2
(get-reg_1))))
(if or-part_0
or-part_0
(call-with-values
(lambda ()
(split-relative-string
(symbol->string s_2)
#f))
(case-lambda
((cols_0 file_0)
(let ((f-file_0
(if (null?
cols_0)
"main.rkt"
(string-append
file_0
".rkt"))))
(let ((col_0
(if (null?
cols_0)
file_0
(car
cols_0))))
(let ((col-path_0
(if (null?
cols_0)
null
(cdr
cols_0))))
(find-col-file
(if (not
subm-path_0)
show-collection-err_1
(invent-collection-dir_1
f-file_0
col_0
col-path_0
show-collection-err_1))
col_0
col-path_0
f-file_0
#t)))))
(args
(raise-binding-result-arity-error
2
args))))))
(if (string? s_2)
(let ((dir_0 (get-dir_1)))
(let ((or-part_0
(path-cache-get
(cons s_2 dir_0)
#f)))
(if or-part_0
or-part_0
(call-with-values
(lambda ()
(split-relative-string
s_2
#f))
(case-lambda
((cols_0 file_0)
(if (null? cols_0)
(build-path
dir_0
(ss->rkt_1
file_0))
(apply
build-path
dir_0
(let ((app_0
(map_1346
(lambda (s_3)
(if (string=?
s_3
".")
'same
(if (string=?
s_3
"..")
'up
s_3)))
cols_0)))
(append
app_0
(list
(ss->rkt_1
file_0)))))))
(args
(raise-binding-result-arity-error
2
args)))))))
(if (path? s_2)
(path-ss->rkt_1
(simplify-path
(if (complete-path? s_2)
s_2
(path->complete-path
s_2
(get-dir_1)))))
(if (eq? (car s_2) 'lib)
(let ((or-part_0
(path-cache-get
s_2
(get-reg_1))))
(if or-part_0
or-part_0
(call-with-values
(lambda ()
(split-relative-string
(cadr s_2)
#f))
(case-lambda
((cols_0 file_0)
(let ((old-style?_0
(if (null?
(cddr
s_2))
(if (null?
cols_0)
(regexp-match?
rx2668
file_0)
#f)
#t)))
(let ((f-file_0
(if old-style?_0
(ss->rkt_1
file_0)
(if (null?
cols_0)
"main.rkt"
(if (regexp-match?
rx2668
file_0)
(ss->rkt_1
file_0)
(string-append
file_0
".rkt"))))))
(let ((cols_1
(if old-style?_0
(append
(if (null?
(cddr
s_2))
'("mzlib")
(apply
append
(map_1346
(lambda (p_0)
(split-relative-string
p_0
#t))
(cddr
s_2))))
cols_0)
(if (null?
cols_0)
(list
file_0)
cols_0))))
(let ((app_0
(car
cols_1)))
(find-col-file
show-collection-err_1
app_0
(cdr
cols_1)
f-file_0
#t))))))
(args
(raise-binding-result-arity-error
2
args))))))
(if (eq?
(car s_2)
'file)
(path-ss->rkt_1
(simplify-path
(let ((app_0
(expand-user-path
(cadr
s_2))))
(path->complete-path
app_0
(get-dir_1)))))
(void))))))))
(if (symbol? s-parsed_0)
(1/make-resolved-module-path
(cons s-parsed_0 subm-path_0))
(if (not
(let ((or-part_0
(path? s-parsed_0)))
(if or-part_0
or-part_0
(vector? s-parsed_0))))
(if stx_0
(raise-syntax-error$1
'require
(format
"bad module path~a"
(if s-parsed_0
(car s-parsed_0)
""))
stx_0)
(raise-argument-error
'standard-module-name-resolver
"module-path?"
s_2))
(let ((filename_0
(if (vector? s-parsed_0)
(vector-ref
s-parsed_0
0)
(simplify-path
(cleanse-path
s-parsed_0)
#f))))
(let ((normal-filename_0
(if (vector? s-parsed_0)
(vector-ref
s-parsed_0
1)
(normal-case-path
filename_0))))
(call-with-values
(lambda ()
(if (vector? s-parsed_0)
(values
'ignored
(vector-ref
s-parsed_0
2)
'ignored)
(split-path
filename_0)))
(case-lambda
((base_0 name_0 dir?_0)
(let ((no-sfx_0
(if (vector?
s-parsed_0)
(vector-ref
s-parsed_0
3)
(path-replace-extension
name_0
#vu8()))))
(let ((root-modname_0
(if (vector?
s-parsed_0)
(vector-ref
s-parsed_0
4)
(1/make-resolved-module-path
filename_0))))
(let ((hts_0
(let ((or-part_0
(registry-table-ref
(get-reg_1))))
(if or-part_0
or-part_0
(let ((hts_0
(let ((app_0
(make-hasheq)))
(cons
app_0
(make-hasheq)))))
(begin
(registry-table-set!
(get-reg_1)
hts_0)
hts_0))))))
(let ((modname_0
(if subm-path_0
(1/make-resolved-module-path
(cons
(1/resolved-module-path-name
root-modname_0)
subm-path_0))
root-modname_0)))
(begin
(if load?_0
(let ((got_0
(hash-ref
(car
hts_0)
modname_0
#f)))
(if got_0
(void)
(let ((loading_0
(let ((tag_0
(if (continuation-prompt-available?
-loading-prompt-tag)
-loading-prompt-tag
(default-continuation-prompt-tag))))
(continuation-mark-set-first
#f
-loading-filename
null
tag_0))))
(let ((nsr_0
(get-reg_1)))
(let ((loading_1
loading_0))
(begin
(for-each_2380
(lambda (s_3)
(if (if (equal?
(cdr
s_3)
normal-filename_0)
(eq?
(car
s_3)
nsr_0)
#f)
(error
'standard-module-name-resolver
"cycle in loading\n at path: ~a\n paths:~a"
filename_0
(apply
string-append
(letrec*
((loop_0
(|#%name|
loop
(lambda (l_0)
(begin
(if (null?
l_0)
'()
(let ((app_0
(path->string
(cdar
l_0))))
(list*
"\n "
app_0
(loop_0
(cdr
l_0))))))))))
(loop_0
(reverse$1
loading_1)))))
(void)))
loading_1)
(|#%app|
(if (continuation-prompt-available?
-loading-prompt-tag)
(lambda (f_0)
(|#%app|
f_0))
(lambda (f_0)
(call-with-continuation-prompt
f_0
-loading-prompt-tag)))
(lambda ()
(with-continuation-mark*
general
-loading-filename
(cons
(cons
nsr_0
normal-filename_0)
loading_1)
(with-continuation-mark*
authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
1/current-module-declare-name
root-modname_0
1/current-module-path-for-load
(let ((app_1
(if stx_0
(lambda (p_0)
(1/datum->syntax
#f
p_0
stx_0))
values)))
(|#%app|
app_1
(if (symbol?
s_2)
s_2
(if (if (pair?
s_2)
(eq?
(car
s_2)
'lib)
#f)
s_2
(if (1/resolved-module-path?
root-modname_0)
(let ((src_0
(1/resolved-module-path-name
root-modname_0)))
(if (symbol?
src_0)
(list
'quote
src_0)
src_0))
root-modname_0)))))))
(let ((app_0
(1/current-load/use-compiled)))
(|#%app|
app_0
filename_0
(let ((sym_0
(string->symbol
(path->string
no-sfx_0))))
(if subm-path_0
(if (hash-ref
(car
hts_0)
root-modname_0
#f)
(cons
#f
subm-path_0)
(cons
sym_0
subm-path_0))
sym_0))))))))))))))
(void))
(if (if (not
(vector?
s-parsed_0))
(if load?_0
(let ((or-part_0
(string?
s_2)))
(if or-part_0
or-part_0
(let ((or-part_1
(symbol?
s_2)))
(if or-part_1
or-part_1
(if (pair?
s_2)
(eq?
(car
s_2)
'lib)
#f)))))
#f)
#f)
(let ((app_0
(if (string?
s_2)
(cons
s_2
(get-dir_1))
s_2)))
(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
(raise-binding-result-arity-error
3
args))))))))))))))))))))))))))))))
(define default-eval-handler
(lambda (s_0)
(let ((app_0 (1/current-namespace)))
(1/eval
s_0
app_0
(let ((c_0 (1/current-compile)))
(lambda (e_0 ns_0)
(if (eq? ns_0 (1/current-namespace))
(|#%app| c_0 e_0 #t)
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/current-namespace
ns_0)
(|#%app| c_0 e_0 #t)))))))))
(define default-compile-handler
(lambda (s_0 immediate-eval?_0)
(1/compile s_0 (1/current-namespace) (not immediate-eval?_0))))
(define default-read-interaction
(lambda (src_0 in_0)
(begin
(if (input-port? in_0)
(void)
(raise-argument-error 'default-read-interaction "input-port?" in_0))
(with-continuation-mark*
authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first #f parameterization-key)
1/read-accept-reader
#t
1/read-accept-lang
#f)
(1/read-syntax src_0 in_0)))))
(define boot
(lambda ()
(begin
(unsafe-place-local-set! cell.1 (make-weak-hasheq))
(unsafe-place-local-set! cell.2 (make-weak-hasheq))
(seal)
(|#%app| 1/current-module-name-resolver standard-module-name-resolver)
(1/current-load/use-compiled default-load/use-compiled)
(1/current-reader-guard default-reader-guard)
(1/current-eval default-eval-handler)
(1/current-compile default-compile-handler)
(1/current-load default-load-handler)
(current-read-interaction default-read-interaction))))
(define seal
(lambda ()
(unsafe-place-local-set!
cell.5
(reparameterize (continuation-mark-set-first #f parameterization-key)))))
(define get-original-parameterization
(lambda () (unsafe-place-local-ref cell.5)))
(define boot-primitives
(hash
'boot
boot
'seal
seal
'get-original-parameterization
get-original-parameterization))
(define prepare-next-phase-namespace
(lambda (ctx_0)
(let ((phase_0
(add1
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))))
(let ((ns_0
(namespace->namespace-at-phase
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))
phase_0)))
(namespace-visit-available-modules! ns_0 phase_0)))))
(define expand-body.1
(|#%name|
expand-body
(lambda (source1_0 stratified?2_0 bodys5_0 ctx6_0)
(begin
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx6_0)))))
(if obs_0 (call-expand-observe obs_0 'enter-block bodys5_0) (void)))
(let ((inside-sc_0 (new-scope 'intdef)))
(let ((init-bodys_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((body_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope
body_0
inside-sc_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null bodys5_0))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx6_0)))))
(if obs_0
(call-expand-observe
obs_0
'block-renames
init-bodys_0
bodys5_0)
(void)))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx6_0)))))
(let ((frame-id_0 (make-reference-record)))
(let ((def-ctx-scopes_0 (box null)))
(let ((body-ctx_0
(if (expand-context/outer? ctx6_0)
(let ((context51_0
(list (make-liberal-define-context))))
(let ((post-expansion55_0
(|#%name|
post-expansion55
(lambda (s_0)
(begin
(add-scope s_0 inside-sc_0))))))
(let ((scopes56_0
(cons
inside-sc_0
(begin-unsafe
(expand-context/outer-scopes
ctx6_0)))))
(let ((use-site-scopes57_0 (box null)))
(let ((reference-records59_0
(cons
frame-id_0
(begin-unsafe
(expand-context/outer-reference-records
ctx6_0)))))
(let ((inner60_0
(root-expand-context/outer-inner
ctx6_0)))
(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?"
ctx6_0))))
(let ((maybe-increment-binding-layer_0
(|#%name|
maybe-increment-binding-layer
(lambda (ids_0 body-ctx_1)
(begin
(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
inside-sc_0)
(begin-unsafe
(expand-context/outer-binding-layer
body-ctx_1))))))))
(let ((name_0
(begin-unsafe
(expand-context/outer-name ctx6_0))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (body-ctx_1
bodys_0
done-bodys_0
val-idss_0
val-keyss_0
val-rhss_0
track-stxs_0
trans-idss_0
trans-stxs_0
stx-clauses_0
dups_0
just-saw-define-syntaxes?_0)
(begin
(if (null? bodys_0)
(let ((temp64_0 (reverse$1 val-idss_0)))
(let ((temp65_0
(reverse$1 val-keyss_0)))
(let ((temp66_0
(reverse$1 val-rhss_0)))
(let ((temp67_0
(reverse$1 track-stxs_0)))
(let ((temp68_0
(reverse$1 stx-clauses_0)))
(let ((temp69_0
(reverse$1
done-bodys_0)))
(let ((temp75_0
(reverse$1
trans-idss_0)))
(let ((temp76_0
(reverse$1
trans-stxs_0)))
(let ((temp75_1 temp75_0)
(temp69_1 temp69_0)
(temp68_1 temp68_0)
(temp67_1 temp67_0)
(temp66_1 temp66_0)
(temp65_1 temp65_0)
(temp64_1 temp64_0))
(finish-expanding-body.1
temp75_1
temp76_0
just-saw-define-syntaxes?_0
name_0
init-bodys_0
source1_0
stratified?2_0
body-ctx_1
frame-id_0
def-ctx-scopes_0
temp64_1
temp65_1
temp66_1
temp67_1
temp68_1
temp69_1))))))))))
(let ((rest-bodys_0 (cdr bodys_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe obs_0 'next)
(void)))
(let ((exp-body_0
(let ((temp77_0 (car bodys_0)))
(let ((temp78_0
(if (if name_0
(null?
(cdr bodys_0))
#f)
(if (expand-context/outer?
body-ctx_1)
(let ((inner80_0
(root-expand-context/outer-inner
body-ctx_1)))
(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?"
body-ctx_1))
body-ctx_1)))
(let ((temp77_1 temp77_0))
(expand.1
#f
#f
temp77_1
temp78_0))))))
(let ((disarmed-exp-body_0
(syntax-disarm$1
exp-body_0)))
(let ((tmp_0
(core-form-sym
disarmed-exp-body_0
phase_0)))
(if (eq? tmp_0 'begin)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(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 ((begin83_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((e84_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 ((begin83_1
begin83_0))
(values
begin83_1
e84_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0))))
(case-lambda
((begin81_0 e82_0)
(values
#t
begin81_0
e82_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 begin81_0 e82_0)
(let ((track_0
(|#%name|
track
(lambda (e_0)
(begin
(syntax-track-origin$1
e_0
exp-body_0))))))
(let ((splice-bodys_0
(append
(map_1346
track_0
e82_0)
rest-bodys_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'splice
splice-bodys_0)
(void)))
(loop_0
body-ctx_1
splice-bodys_0
done-bodys_0
val-idss_0
val-keyss_0
val-rhss_0
track-stxs_0
trans-idss_0
trans-stxs_0
stx-clauses_0
dups_0
just-saw-define-syntaxes?_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
body-ctx_1)))))
(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-values88_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 ((id91_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 ((id94_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
id94_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 ((rhs92_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 ((rhs93_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 ((rhs93_1
rhs93_0))
(values
rhs93_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0))))))
(let ((id91_1
id91_0))
(values
id91_1
rhs92_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0)))))
(case-lambda
((id89_0
rhs90_0)
(let ((define-values88_1
define-values88_0))
(values
define-values88_1
id89_0
rhs90_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0))))
(case-lambda
((define-values85_0
id86_0
rhs87_0)
(values
#t
define-values85_0
id86_0
rhs87_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
define-values85_0
id86_0
rhs87_0)
(let ((ids_0
(remove-use-site-scopes
id86_0
body-ctx_1)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'rename-one
(list
ids_0
rhs87_0))
(void)))
(let ((new-dups_0
(check-no-duplicate-ids.1
unsafe-undefined
ids_0
phase_0
exp-body_0
dups_0)))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
ctx6_0)))))
(let ((local-sym_0
(if (begin-unsafe
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner
ctx6_0)))
'loc
#f)))
(let ((keys_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
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-local-binding!.1
frame-id_0
exp-body_0
local-sym_0
id_0
phase_0
counter_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 ((extended-env_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 ((key_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((id_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
body-ctx_1))
keys_0
ids_0)))))
(let ((app_0
(if (expand-context/outer?
body-ctx_1)
(let ((binding-layer106_0
(maybe-increment-binding-layer_0
ids_0
body-ctx_1)))
(let ((inner107_0
(root-expand-context/outer-inner
body-ctx_1)))
(let ((binding-layer106_1
binding-layer106_0))
(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?"
body-ctx_1))))
(let ((app_1
(cons
ids_0
(append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((done-body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(cons
null
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
done-bodys_0))))
val-idss_0))))
(let ((app_2
(cons
keys_0
(append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((done-body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(cons
null
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
done-bodys_0))))
val-keyss_0))))
(let ((app_3
(cons
rhs87_0
(append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((done-body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(no-binds
done-body_0
source1_0
phase_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
done-bodys_0))))
val-rhss_0))))
(loop_0
app_0
rest-bodys_0
null
app_1
app_2
app_3
(let ((app_4
(keep-as-needed.1
#t
#f
#f
body-ctx_1
exp-body_0)))
(cons
app_4
(append
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((done-body_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
done-bodys_0))))
track-stxs_0)))
trans-idss_0
trans-stxs_0
stx-clauses_0
new-dups_0
#f)))))))))))))
(args
(raise-binding-result-arity-error
4
args)))))
(if (eq?
tmp_0
'define-syntaxes)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'prim-define-syntaxes
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-syntaxes114_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 ((id117_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 ((id120_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
id120_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 ((rhs118_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 ((rhs119_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 ((rhs119_1
rhs119_0))
(values
rhs119_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0))))))
(let ((id117_1
id117_0))
(values
id117_1
rhs118_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0)))))
(case-lambda
((id115_0
rhs116_0)
(let ((define-syntaxes114_1
define-syntaxes114_0))
(values
define-syntaxes114_1
id115_0
rhs116_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-exp-body_0))))
(case-lambda
((define-syntaxes111_0
id112_0
rhs113_0)
(values
#t
define-syntaxes111_0
id112_0
rhs113_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
define-syntaxes111_0
id112_0
rhs113_0)
(let ((ids_0
(remove-use-site-scopes
id112_0
body-ctx_1)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'rename-one
(list
ids_0
rhs113_0))
(void)))
(let ((new-dups_0
(check-no-duplicate-ids.1
unsafe-undefined
ids_0
phase_0
exp-body_0
dups_0)))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
ctx6_0)))))
(let ((local-sym_0
(if (begin-unsafe
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner
ctx6_0)))
'mac
#f)))
(let ((keys_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
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-local-binding!.1
frame-id_0
exp-body_0
local-sym_0
id_0
phase_0
counter_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))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'prepare-env)
(void)))
(begin
(prepare-next-phase-namespace
ctx6_0)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'enter-bind)
(void)))
(let ((vals_0
(eval-for-syntaxes-binding
'define-syntaxes
rhs113_0
ids_0
body-ctx_1)))
(let ((extended-env_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (env_0
lst_0
lst_1
lst_2)
(begin
(if (if (pair?
lst_0)
(if (pair?
lst_1)
(pair?
lst_2)
#f)
#f)
(let ((key_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)))
(let ((env_1
(let ((env_1
(begin
(maybe-install-free=id-in-context!
val_0
id_0
phase_0
body-ctx_1)
(begin-unsafe
(hash-set
env_0
key_0
val_0)))))
(values
env_1))))
(for-loop_0
env_1
rest_0
rest_1
rest_2))))))))
env_0))))))
(for-loop_0
(begin-unsafe
(expand-context/outer-env
body-ctx_1))
keys_0
vals_0
ids_0)))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx_1)))))
(if obs_0
(call-expand-observe
obs_0
'exit-bind)
(void)))
(let ((app_0
(if (expand-context/outer?
body-ctx_1)
(let ((binding-layer132_0
(maybe-increment-binding-layer_0
ids_0
body-ctx_1)))
(let ((inner133_0
(root-expand-context/outer-inner
body-ctx_1)))
(let ((binding-layer132_1
binding-layer132_0))
(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
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
args)))))
(if stratified?2_0
(begin
(if (null?
done-bodys_0)
(void)
(error
"internal error: accumulated expressions not empty"))
(loop_0
body-ctx_1
null
(if (if (null?
val-idss_0)
(null?
trans-idss_0)
#f)
(reverse$1
(cons
exp-body_0
rest-bodys_0))
(list
(datum->syntax$1
#f
(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
track-stxs_0
trans-idss_0
trans-stxs_0
stx-clauses_0
dups_0
#f))
(loop_0
body-ctx_1
rest-bodys_0
(cons
exp-body_0
done-bodys_0)
val-idss_0
val-keyss_0
val-rhss_0
track-stxs_0
trans-idss_0
trans-stxs_0
stx-clauses_0
dups_0
#f))))))))))))))))
(loop_0
body-ctx_0
init-bodys_0
null
null
null
null
null
null
null
null
(make-check-no-duplicate-table)
#f))))))))))))))))
(define finish-expanding-body.1
(|#%name|
finish-expanding-body
(lambda (disappeared-transformer-bindings13_0
disappeared-transformer-forms14_0
just-saw-define-syntaxes?11_0
name12_0
original-bodys8_0
source9_0
stratified?10_0
body-ctx22_0
frame-id23_0
def-ctx-scopes24_0
val-idss25_0
val-keyss26_0
val-rhss27_0
track-stxs28_0
stx-clauses29_0
done-bodys30_0)
(begin
(begin
(if (let ((or-part_0 (null? done-bodys30_0)))
(if or-part_0 or-part_0 just-saw-define-syntaxes?11_0))
(let ((app_0 (string->symbol "begin (possibly implicit)")))
(raise-syntax-error$1
app_0
"no expression after a sequence of internal definitions"
(datum->syntax$1 #f (cons 'begin original-bodys8_0) source9_0)
#f
original-bodys8_0))
(void))
(let ((finish-ctx_0
(let ((v_0
(accumulate-def-ctx-scopes
body-ctx22_0
def-ctx-scopes24_0)))
(if (expand-context/outer? v_0)
(let ((use-site-scopes138_0 (box null)))
(let ((scopes139_0
(append
(unbox
(begin-unsafe
(root-expand-context/outer-use-site-scopes
body-ctx22_0)))
(begin-unsafe
(expand-context/outer-scopes body-ctx22_0)))))
(let ((inner143_0
(root-expand-context/outer-inner v_0)))
(let ((scopes139_1 scopes139_0)
(use-site-scopes138_1 use-site-scopes138_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?"
v_0)))))
(let ((finish-bodys_0
(|#%name|
finish-bodys
(lambda ()
(begin
(let ((last-i_0 (sub1 (length done-bodys30_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx22_0)))))
(if obs_0
(call-expand-observe
obs_0
'enter-list
done-bodys30_0)
(void)))
(let ((exp-bodys_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0 pos_0)
(begin
(if (if (pair? lst_0) #t #f)
(let ((done-body_0
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx22_0)))))
(if obs_0
(call-expand-observe
obs_0
'next)
(void)))
(let ((temp145_0
(if (if name12_0
(=
pos_0
last-i_0)
#f)
(if (expand-context/outer?
finish-ctx_0)
(let ((inner147_0
(root-expand-context/outer-inner
finish-ctx_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?"
finish-ctx_0))
finish-ctx_0)))
(expand.1
#f
#f
done-body_0
temp145_0)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0
(+ pos_0 1)))))
fold-var_0))))))
(for-loop_0 null done-bodys30_0 0))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
body-ctx22_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-list
exp-bodys_0)
(void)))
(reference-record-clear! frame-id23_0)
exp-bodys_0)))))))))
(if (if (null? val-idss25_0)
(null? disappeared-transformer-bindings13_0)
#f)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner finish-ctx_0)))))
(if obs_0 (call-expand-observe obs_0 'block->list) (void)))
(finish-bodys_0))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner finish-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'block->letrec
val-idss25_0
val-rhss27_0
done-bodys30_0)
(void)))
(let ((temp152_0 (not stratified?10_0)))
(let ((exp-s_0
(let ((temp156_0 (pair? stx-clauses29_0)))
(expand-and-split-bindings-by-reference.1
finish-ctx_0
frame-id23_0
finish-bodys_0
temp156_0
source9_0
temp152_0
#f
val-idss25_0
val-keyss26_0
val-rhss27_0
track-stxs28_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner body-ctx22_0)))
(list exp-s_0)
(let ((exp-s_1
(attach-disappeared-transformer-bindings
exp-s_0
disappeared-transformer-bindings13_0)))
(let ((tracked-exp-s_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (exp-s_2 lst_0)
(begin
(if (pair? lst_0)
(let ((form_0 (unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((exp-s_3
(if form_0
(let ((exp-s_3
(syntax-track-origin$1
exp-s_2
form_0)))
(values exp-s_3))
exp-s_2)))
(for-loop_0
exp-s_3
rest_0))))
exp-s_2))))))
(for-loop_0
exp-s_1
disappeared-transformer-forms14_0)))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
finish-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'finish-block
(list tracked-exp-s_0))
(void)))
(list tracked-exp-s_0))))))))))))))))
(define expand-and-split-bindings-by-reference.1
(|#%name|
expand-and-split-bindings-by-reference
(lambda (ctx34_0
frame-id33_0
get-body37_0
had-stxes?36_0
source35_0
split?32_0
track?38_0
idss46_0
keyss47_0
rhss48_0
track-stxs49_0)
(begin
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx34_0)))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (idss_0
keyss_0
rhss_0
track-stxs_0
accum-idss_0
accum-keyss_0
accum-rhss_0
accum-track-stxs_0
track?_0
get-list?_0)
(begin
(if (null? idss_0)
(if (if (null? accum-idss_0) get-list?_0 #f)
(|#%app| get-body37_0)
(let ((exp-body_0 (|#%app| get-body37_0)))
(let ((result-s_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx34_0)))
(if (null? accum-idss_0)
(parsed-let-values17.1
(keep-properties-only source35_0)
null
null
exp-body_0)
(let ((app_0
(keep-properties-only source35_0)))
(let ((app_1 (reverse$1 accum-idss_0)))
(parsed-letrec-values18.1
app_0
app_1
(reverse$1
(map_1346
list
accum-keyss_0
accum-rhss_0))
exp-body_0))))
(let ((temp161_0
(let ((app_0
(if (null? accum-idss_0)
(core-id 'let-values phase_0)
(core-id
'letrec-values
phase_0))))
(list*
app_0
(build-clauses
accum-idss_0
accum-rhss_0
accum-track-stxs_0)
exp-body_0))))
(rebuild.1 track?_0 source35_0 temp161_0)))))
(if get-list?_0 (list result-s_0) result-s_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx34_0)))))
(if obs_0 (call-expand-observe obs_0 'next) (void)))
(let ((ids_0 (car idss_0)))
(let ((expanded-rhs_0
(let ((temp162_0 (car rhss_0)))
(let ((temp163_0
(as-named-context ctx34_0 ids_0)))
(let ((temp162_1 temp162_0))
(expand.1 #f #f temp162_1 temp163_0))))))
(let ((track-stx_0 (car track-stxs_0)))
(let ((local-or-forward-references?_0
(reference-record-forward-references?
frame-id33_0)))
(begin
(reference-record-bound!
frame-id33_0
(car keyss_0))
(let ((forward-references?_0
(reference-record-forward-references?
frame-id33_0)))
(if (if (not local-or-forward-references?_0)
split?32_0
#f)
(begin
(if (null? accum-idss_0)
(void)
(error
"internal error: accumulated ids not empty"))
(let ((exp-rest_0
(let ((app_0 (cdr idss_0)))
(let ((app_1 (cdr keyss_0)))
(let ((app_2 (cdr rhss_0)))
(loop_0
app_0
app_1
app_2
(cdr track-stxs_0)
null
null
null
null
#f
#t))))))
(let ((result-s_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx34_0)))
(let ((app_0
(keep-properties-only
source35_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
'let-values
phase_0)))
(list*
app_0
(list
(build-clause
ids_0
expanded-rhs_0
track-stx_0))
exp-rest_0))))
(rebuild.1
track?_0
source35_0
temp166_0)))))
(if get-list?_0
(list result-s_0)
result-s_0))))
(if (if (not forward-references?_0)
(if split?32_0
split?32_0
(null? (cdr idss_0)))
#f)
(let ((exp-rest_0
(let ((app_0 (cdr idss_0)))
(let ((app_1 (cdr keyss_0)))
(let ((app_2 (cdr rhss_0)))
(loop_0
app_0
app_1
app_2
(cdr track-stxs_0)
null
null
null
null
#f
#t))))))
(let ((result-s_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx34_0)))
(let ((app_0
(keep-properties-only
source35_0)))
(let ((app_1
(reverse$1
(cons
ids_0
accum-idss_0))))
(parsed-letrec-values18.1
app_0
app_1
(reverse$1
(let ((app_2
(list
(car keyss_0)
expanded-rhs_0)))
(cons
app_2
(map_1346
list
accum-keyss_0
accum-rhss_0))))
exp-rest_0)))
(let ((temp169_0
(let ((app_0
(core-id
'letrec-values
phase_0)))
(list*
app_0
(build-clauses
(cons
ids_0
accum-idss_0)
(cons
expanded-rhs_0
accum-rhss_0)
(cons
track-stx_0
accum-track-stxs_0))
exp-rest_0))))
(rebuild.1
track?_0
source35_0
temp169_0)))))
(if get-list?_0
(list result-s_0)
result-s_0)))
(let ((app_0 (cdr idss_0)))
(let ((app_1 (cdr keyss_0)))
(let ((app_2 (cdr rhss_0)))
(let ((app_3 (cdr track-stxs_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
rhss48_0
track-stxs49_0
null
null
null
null
track?38_0
#f)))))))
(define build-clauses
(lambda (accum-idss_0 accum-rhss_0 accum-track-stxs_0)
(let ((app_0 (reverse$1 accum-idss_0)))
(let ((app_1 (reverse$1 accum-rhss_0)))
(map_1346 build-clause app_0 app_1 (reverse$1 accum-track-stxs_0))))))
(define build-clause
(lambda (ids_0 rhs_0 track-stx_0)
(let ((clause_0 (datum->syntax$1 #f (list ids_0 rhs_0))))
(if track-stx_0 (syntax-track-origin$1 clause_0 track-stx_0) clause_0))))
(define no-binds
(lambda (expr_0 s_0 phase_0)
(let ((s-runtime-stx_0 (syntax-shift-phase-level$1 runtime-stx phase_0)))
(let ((app_0 (core-id '|#%app| phase_0)))
(datum->syntax$1
app_0
(let ((app_1 (core-id 'begin phase_0)))
(list
app_1
expr_0
(list (datum->syntax$1 s-runtime-stx_0 'values))))
s_0)))))
(define lambda-clause-expander
(lambda (s_0 disarmed-s_0 formals_0 bodys_0 ctx_0)
(let ((sc_0
(if (not
(begin-unsafe
(expand-context/inner-parsing-expanded?
(root-expand-context/outer-inner ctx_0))))
(new-scope 'local)
#f)))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((ids_0
(|#%app|
parse-and-flatten-formals
formals_0
sc_0
disarmed-s_0)))
(begin
(let ((temp18_0 "argument name"))
(check-no-duplicate-ids.1
temp18_0
ids_0
phase_0
s_0
unsafe-undefined))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner ctx_0)))))
(let ((local-sym_0
(if (begin-unsafe
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner ctx_0)))
'arg
#f)))
(let ((keys_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(if sc_0
(add-local-binding!.1
#f
s_0
local-sym_0
id_0
phase_0
counter_0)
(existing-binding-key
id_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner
ctx_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 ((body-env_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 ((key_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((id_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 ctx_0))
keys_0
ids_0)))))
(let ((sc-formals_0
(if sc_0 (add-scope formals_0 sc_0) formals_0)))
(let ((sc-bodys_0
(if sc_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((body_0 (unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope
body_0
sc_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null bodys_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
'lambda-renames
sc-formals_0
sc-bodys_0)
(void)))
(let ((body-ctx_0
(if (expand-context/outer? ctx_0)
(let ((scopes25_0
(if sc_0
(cons
sc_0
(begin-unsafe
(expand-context/outer-scopes
ctx_0)))
(begin-unsafe
(expand-context/outer-scopes
ctx_0)))))
(let ((binding-layer26_0
(if sc_0
(increment-binding-layer
ids_0
ctx_0
sc_0)
(begin-unsafe
(expand-context/outer-binding-layer
ctx_0)))))
(let ((inner28_0
(root-expand-context/outer-inner
ctx_0)))
(let ((binding-layer26_1
binding-layer26_0)
(scopes25_1 scopes25_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?"
ctx_0))))
(let ((exp-body_0
(if sc_0
(let ((temp31_0
(keep-as-needed.1
#f
#t
#f
ctx_0
s_0)))
(expand-body.1
temp31_0
#f
sc-bodys_0
body-ctx_0))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((sc-body_0
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(expand.1
#f
#f
sc-body_0
body-ctx_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null sc-bodys_0)))))))
(values
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(|#%app|
unflatten-like-formals
keys_0
formals_0)
sc-formals_0)
exp-body_0))))))))))))))))
(define effect_2420
(begin
(void
(add-core-form!*
'lambda
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-lambda disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((lambda40_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(let ((formals43_0
(let ((s_4 (car s_3))) s_4)))
(let ((body44_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1 s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(if (null? flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0)))))))
(let ((formals43_1 formals43_0))
(values formals43_1 body44_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((formals41_0 body42_0)
(let ((lambda40_1 lambda40_0))
(values lambda40_1 formals41_0 body42_0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((lambda37_0 formals38_0 body39_0)
(values #t lambda37_0 formals38_0 body39_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 lambda37_0 formals38_0 body39_0)
(let ((rebuild-s_0 (keep-as-needed.1 #f #f #t ctx_0 s_0)))
(call-with-values
(lambda ()
(lambda-clause-expander
s_0
disarmed-s_0
formals38_0
body39_0
ctx_0))
(case-lambda
((formals_0 body_0)
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-lambda5.1 rebuild-s_0 formals_0 body_0)
(let ((temp49_0 (list* lambda37_0 formals_0 body_0)))
(rebuild.1 #t rebuild-s_0 temp49_0))))
(args (raise-binding-result-arity-error 2 args))))))
(args (raise-binding-result-arity-error 4 args)))))))))
(void)))
(define effect_1841
(begin
(void
(add-core-form!*
'λ
(lambda (s_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0)))
(if (pair? s_1)
(let ((lam-id53_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3 (if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(let ((formals56_0 (let ((s_4 (car s_3))) s_4)))
(let ((_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1 s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
s_0)
(if (null? flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
s_0)
flat-s_0)))))))
(let ((formals56_1 formals56_0))
(values formals56_1 _0))))
(raise-syntax-error$1 #f "bad syntax" s_0)))))
(case-lambda
((formals54_0 _0)
(let ((lam-id53_1 lam-id53_0))
(values lam-id53_1 formals54_0 _0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" s_0))))
(case-lambda
((lam-id50_0 formals51_0 _0)
(values #t lam-id50_0 formals51_0 _0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 lam-id50_0 formals51_0 _0)
(let ((ids_0
(|#%app| parse-and-flatten-formals formals51_0 #f s_0)))
(let ((ctx_0 (get-current-expand-context.1 #t 'unexpected)))
(let ((phase_0
(if ctx_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))
0)))
(begin
(let ((temp61_0 "argument name"))
(check-no-duplicate-ids.1
temp61_0
ids_0
phase_0
s_0
unsafe-undefined))
(datum->syntax$1
s_0
(let ((app_0
(datum->syntax$1
(syntax-shift-phase-level$1 core-stx phase_0)
'lambda
lam-id50_0
lam-id50_0)))
(cons app_0 (cdr (syntax-e$1 s_0))))
s_0
s_0))))))
(args (raise-binding-result-arity-error 4 args)))))))
(void)))
(define effect_3181
(begin
(void
(add-core-form!*
'case-lambda
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-case-lambda disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((case-lambda66_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (formals_0 body_0 lst_0)
(begin
(if (pair? lst_0)
(let ((s_4
(unsafe-car lst_0)))
(let ((rest_0
(unsafe-cdr lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_5
(if (syntax?$1
s_4)
(syntax-e$1
s_4)
s_4)))
(if (pair?
s_5)
(let ((formals69_0
(let ((s_6
(car
s_5)))
s_6)))
(let ((body70_0
(let ((s_6
(cdr
s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(let ((flat-s_1
(to-syntax-list.1
s_7)))
(if (not
flat-s_1)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(if (null?
flat-s_1)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_1)))))))
(let ((formals69_1
formals69_0))
(values
formals69_1
body70_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((formals75_0
body76_0)
(values
(cons
formals75_0
formals_0)
(cons
body76_0
body_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((formals_1 body_1)
(values
formals_1
body_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((formals_1 body_1)
(for-loop_0
formals_1
body_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
formals_0
body_0)))))))
(for-loop_0 null null flat-s_0))))
(case-lambda
((formals_0 body_0)
(let ((app_0 (reverse$1 formals_0)))
(values app_0 (reverse$1 body_0))))
(args
(raise-binding-result-arity-error
2
args)))))))))
(case-lambda
((formals67_0 body68_0)
(let ((case-lambda66_1 case-lambda66_0))
(values case-lambda66_1 formals67_0 body68_0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((case-lambda63_0 formals64_0 body65_0)
(values #t case-lambda63_0 formals64_0 body65_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 case-lambda63_0 formals64_0 body65_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((case-lambda73_0 (let ((s_2 (car s_1))) s_2)))
(let ((clause74_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0))))))
(let ((case-lambda73_1 case-lambda73_0))
(values case-lambda73_1 clause74_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((case-lambda71_0 clause72_0)
(values #t case-lambda71_0 clause72_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_1 case-lambda71_0 clause72_0)
(let ((rebuild-s_0 (keep-as-needed.1 #f #f #t ctx_0 s_0)))
(let ((clauses_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0 lst_1 lst_2)
(begin
(if (if (pair? lst_0)
(if (pair? lst_1) (pair? lst_2) #f)
#f)
(let ((formals_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((body_0 (unsafe-car lst_1)))
(let ((rest_1
(unsafe-cdr lst_1)))
(let ((clause_0
(unsafe-car lst_2)))
(let ((rest_2
(unsafe-cdr lst_2)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(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 ((rebuild-clause_0
(keep-as-needed.1
#f
#f
#f
ctx_0
clause_0)))
(call-with-values
(lambda ()
(lambda-clause-expander
s_0
disarmed-s_0
formals_0
body_0
ctx_0))
(case-lambda
((exp-formals_0
exp-body_0)
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
(list
exp-formals_0
exp-body_0)
(let ((temp83_0
(list*
exp-formals_0
exp-body_0)))
(rebuild.1
#t
rebuild-clause_0
temp83_0))))
(args
(raise-binding-result-arity-error
2
args))))))
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
formals64_0
body65_0
clause72_0))))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-case-lambda6.1 rebuild-s_0 clauses_0)
(let ((temp85_0 (list* case-lambda63_0 clauses_0)))
(rebuild.1 #t rebuild-s_0 temp85_0))))))
(args (raise-binding-result-arity-error 3 args)))))
(args (raise-binding-result-arity-error 4 args)))))))))
(void)))
(define parse-and-flatten-formals
(lambda (all-formals_0 sc_0 s_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (formals_0)
(begin
(if (identifier? formals_0)
(list (if sc_0 (add-scope formals_0 sc_0) formals_0))
(if (syntax?$1 formals_0)
(let ((p_0 (syntax-e$1 formals_0)))
(if (pair? p_0)
(loop_0 p_0)
(if (null? p_0)
null
(raise-syntax-error$1 #f "not an identifier" s_0 p_0))))
(if (pair? formals_0)
(begin
(if (identifier? (car formals_0))
(void)
(raise-syntax-error$1
#f
"not an identifier"
s_0
(car formals_0)))
(let ((app_0
(if sc_0
(add-scope (car formals_0) sc_0)
(car formals_0))))
(cons app_0 (loop_0 (cdr formals_0)))))
(if (null? formals_0)
null
(raise-syntax-error$1
"bad argument sequence"
s_0
all-formals_0))))))))))
(loop_0 all-formals_0))))
(define unflatten-like-formals
(lambda (keys_0 formals_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (keys_1 formals_1)
(begin
(if (null? formals_1)
null
(if (pair? formals_1)
(let ((app_0 (car keys_1)))
(cons
app_0
(let ((app_1 (cdr keys_1)))
(loop_0 app_1 (cdr formals_1)))))
(if (syntax?$1 formals_1)
(loop_0 keys_1 (syntax-e$1 formals_1))
(car keys_1)))))))))
(loop_0 keys_0 formals_0))))
(define make-let-values-form.1
(|#%name|
make-let-values-form
(lambda (log-tag1_0 rec?3_0 split-by-reference?4_0 syntaxes?2_0)
(begin
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 log-tag1_0 disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(if (if syntaxes?2_0 #t #f)
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((letrec-syntaxes+values92_0
(let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(call-with-values
(lambda ()
(let ((s_4 (car s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1 s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (id:trans_0
trans-rhs_0
lst_0)
(begin
(if (pair? lst_0)
(let ((s_6
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (pair?
s_7)
(let ((id:trans103_0
(let ((s_8
(car
s_7)))
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(let ((flat-s_1
(to-syntax-list.1
s_9)))
(if (not
flat-s_1)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(let ((id:trans_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id:trans_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_10
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id:trans_2
(let ((id:trans_2
(let ((id:trans131_0
(if (let ((or-part_0
(if (syntax?$1
s_10)
(symbol?
(syntax-e$1
s_10))
#f)))
(if or-part_0
or-part_0
(symbol?
s_10)))
s_10
(raise-syntax-error$1
#f
"not an identifier"
disarmed-s_0
s_10))))
(cons
id:trans131_0
id:trans_1))))
(values
id:trans_2))))
(for-loop_1
id:trans_2
rest_1))))
id:trans_1))))))
(for-loop_1
null
flat-s_1)))))
(reverse$1
id:trans_1))))))))
(let ((trans-rhs104_0
(let ((s_8
(cdr
s_7)))
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(if (pair?
s_9)
(let ((trans-rhs105_0
(let ((s_10
(car
s_9)))
s_10)))
(call-with-values
(lambda ()
(let ((s_10
(cdr
s_9)))
(let ((s_11
(if (syntax?$1
s_10)
(syntax-e$1
s_10)
s_10)))
(if (null?
s_11)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((trans-rhs105_1
trans-rhs105_0))
(values
trans-rhs105_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((id:trans103_1
id:trans103_0))
(values
id:trans103_1
trans-rhs104_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((id:trans129_0
trans-rhs130_0)
(values
(cons
id:trans129_0
id:trans_0)
(cons
trans-rhs130_0
trans-rhs_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((id:trans_1
trans-rhs_1)
(values
id:trans_1
trans-rhs_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((id:trans_1
trans-rhs_1)
(for-loop_0
id:trans_1
trans-rhs_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
id:trans_0
trans-rhs_0)))))))
(for-loop_0
null
null
flat-s_0))))
(case-lambda
((id:trans_0 trans-rhs_0)
(let ((app_0
(reverse$1
id:trans_0)))
(values
app_0
(reverse$1 trans-rhs_0))))
(args
(raise-binding-result-arity-error
2
args)))))))))
(case-lambda
((id:trans98_0 trans-rhs99_0)
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(call-with-values
(lambda ()
(let ((s_6 (car s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(let ((flat-s_0
(to-syntax-list.1
s_7)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (id:val_0
val-rhs_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((s_8
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(if (pair?
s_9)
(let ((id:val109_0
(let ((s_10
(car
s_9)))
(let ((s_11
(if (syntax?$1
s_10)
(syntax-e$1
s_10)
s_10)))
(let ((flat-s_1
(to-syntax-list.1
s_11)))
(if (not
flat-s_1)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(let ((id:val_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id:val_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_12
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id:val_2
(let ((id:val_2
(let ((id:val134_0
(if (let ((or-part_0
(if (syntax?$1
s_12)
(symbol?
(syntax-e$1
s_12))
#f)))
(if or-part_0
or-part_0
(symbol?
s_12)))
s_12
(raise-syntax-error$1
#f
"not an identifier"
disarmed-s_0
s_12))))
(cons
id:val134_0
id:val_1))))
(values
id:val_2))))
(for-loop_1
id:val_2
rest_1))))
id:val_1))))))
(for-loop_1
null
flat-s_1)))))
(reverse$1
id:val_1))))))))
(let ((val-rhs110_0
(let ((s_10
(cdr
s_9)))
(let ((s_11
(if (syntax?$1
s_10)
(syntax-e$1
s_10)
s_10)))
(if (pair?
s_11)
(let ((val-rhs111_0
(let ((s_12
(car
s_11)))
s_12)))
(call-with-values
(lambda ()
(let ((s_12
(cdr
s_11)))
(let ((s_13
(if (syntax?$1
s_12)
(syntax-e$1
s_12)
s_12)))
(if (null?
s_13)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((val-rhs111_1
val-rhs111_0))
(values
val-rhs111_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((id:val109_1
id:val109_0))
(values
id:val109_1
val-rhs110_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((id:val132_0
val-rhs133_0)
(values
(cons
id:val132_0
id:val_0)
(cons
val-rhs133_0
val-rhs_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((id:val_1
val-rhs_1)
(values
id:val_1
val-rhs_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((id:val_1
val-rhs_1)
(for-loop_0
id:val_1
val-rhs_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
id:val_0
val-rhs_0)))))))
(for-loop_0
null
null
flat-s_0))))
(case-lambda
((id:val_0
val-rhs_0)
(let ((app_0
(reverse$1
id:val_0)))
(values
app_0
(reverse$1
val-rhs_0))))
(args
(raise-binding-result-arity-error
2
args)))))))))
(case-lambda
((id:val106_0 val-rhs107_0)
(let ((body108_0
(let ((s_6
(cdr s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(let ((flat-s_0
(to-syntax-list.1
s_7)))
(if (not
flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(if (null?
flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0)))))))
(let ((id:val106_1
id:val106_0)
(val-rhs107_1
val-rhs107_0))
(values
id:val106_1
val-rhs107_1
body108_0))))
(args
(raise-binding-result-arity-error
2
args))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((id:val100_0 val-rhs101_0 body102_0)
(let ((id:trans98_1 id:trans98_0)
(trans-rhs99_1 trans-rhs99_0))
(values
id:trans98_1
trans-rhs99_1
id:val100_0
val-rhs101_0
body102_0)))
(args
(raise-binding-result-arity-error
3
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((id:trans93_0
trans-rhs94_0
id:val95_0
val-rhs96_0
body97_0)
(let ((letrec-syntaxes+values92_1
letrec-syntaxes+values92_0))
(values
letrec-syntaxes+values92_1
id:trans93_0
trans-rhs94_0
id:val95_0
val-rhs96_0
body97_0)))
(args
(raise-binding-result-arity-error 5 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((letrec-syntaxes+values86_0
id:trans87_0
trans-rhs88_0
id:val89_0
val-rhs90_0
body91_0)
(values
#t
letrec-syntaxes+values86_0
id:trans87_0
trans-rhs88_0
id:val89_0
val-rhs90_0
body91_0))
(args (raise-binding-result-arity-error 6 args))))
(values #f #f #f #f #f #f #f)))
(case-lambda
((ok?_0
letrec-syntaxes+values86_0
id:trans87_0
trans-rhs88_0
id:val89_0
val-rhs90_0
body91_0)
(call-with-values
(lambda ()
(if (if (not syntaxes?2_0) #t #f)
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((let-values116_0
(let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(call-with-values
(lambda ()
(let ((s_4 (car s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1 s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (id:val_0
val-rhs_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((s_6
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (pair?
s_7)
(let ((id:val123_0
(let ((s_8
(car
s_7)))
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(let ((flat-s_1
(to-syntax-list.1
s_9)))
(if (not
flat-s_1)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(let ((id:val_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id:val_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_10
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id:val_2
(let ((id:val_2
(let ((id:val137_0
(if (let ((or-part_0
(if (syntax?$1
s_10)
(symbol?
(syntax-e$1
s_10))
#f)))
(if or-part_0
or-part_0
(symbol?
s_10)))
s_10
(raise-syntax-error$1
#f
"not an identifier"
disarmed-s_0
s_10))))
(cons
id:val137_0
id:val_1))))
(values
id:val_2))))
(for-loop_1
id:val_2
rest_1))))
id:val_1))))))
(for-loop_1
null
flat-s_1)))))
(reverse$1
id:val_1))))))))
(let ((val-rhs124_0
(let ((s_8
(cdr
s_7)))
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(if (pair?
s_9)
(let ((val-rhs125_0
(let ((s_10
(car
s_9)))
s_10)))
(call-with-values
(lambda ()
(let ((s_10
(cdr
s_9)))
(let ((s_11
(if (syntax?$1
s_10)
(syntax-e$1
s_10)
s_10)))
(if (null?
s_11)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((val-rhs125_1
val-rhs125_0))
(values
val-rhs125_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((id:val123_1
id:val123_0))
(values
id:val123_1
val-rhs124_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((id:val135_0
val-rhs136_0)
(values
(cons
id:val135_0
id:val_0)
(cons
val-rhs136_0
val-rhs_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((id:val_1
val-rhs_1)
(values
id:val_1
val-rhs_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((id:val_1
val-rhs_1)
(for-loop_0
id:val_1
val-rhs_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values
id:val_0
val-rhs_0)))))))
(for-loop_0
null
null
flat-s_0))))
(case-lambda
((id:val_0 val-rhs_0)
(let ((app_0
(reverse$1
id:val_0)))
(values
app_0
(reverse$1
val-rhs_0))))
(args
(raise-binding-result-arity-error
2
args)))))))))
(case-lambda
((id:val120_0 val-rhs121_0)
(let ((body122_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1
s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(if (null? flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0)))))))
(let ((id:val120_1 id:val120_0)
(val-rhs121_1 val-rhs121_0))
(values
id:val120_1
val-rhs121_1
body122_0))))
(args
(raise-binding-result-arity-error
2
args))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((id:val117_0 val-rhs118_0 body119_0)
(let ((let-values116_1 let-values116_0))
(values
let-values116_1
id:val117_0
val-rhs118_0
body119_0)))
(args
(raise-binding-result-arity-error 3 args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((let-values112_0 id:val113_0 val-rhs114_0 body115_0)
(values
#t
let-values112_0
id:val113_0
val-rhs114_0
body115_0))
(args (raise-binding-result-arity-error 4 args))))
(values #f #f #f #f #f)))
(case-lambda
((ok?_1 let-values112_0 id:val113_0 val-rhs114_0 body115_0)
(let ((sc_0
(if (not
(begin-unsafe
(expand-context/inner-parsing-expanded?
(root-expand-context/outer-inner ctx_0))))
(new-scope 'local)
#f)))
(begin
(if (if syntaxes?2_0 (not sc_0) #f)
(raise-syntax-error$1
#f
"encountered `letrec-syntaxes` in form that should be fully expanded"
s_0)
(void))
(let ((body-sc_0
(if sc_0
(if rec?3_0 (new-scope 'letrec-body) #f)
#f)))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((frame-id_0
(if syntaxes?2_0
(make-reference-record)
#f)))
(let ((trans-idss_0
(reverse$1
(let ((lst_0
(if syntaxes?2_0
id:trans87_0
null)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_1)
(begin
(if (pair? lst_1)
(let ((ids_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_2)
(begin
(if (pair?
lst_2)
(let ((id_0
(unsafe-car
lst_2)))
(let ((rest_1
(unsafe-cdr
lst_2)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(add-scope
id_0
sc_0)
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
ids_0))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null lst_0)))))))
(let ((trans-rhss_0
(if syntaxes?2_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((rhs_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope
rhs_0
sc_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null trans-rhs88_0))))
'())))
(let ((val-idss_0
(let ((val-idss_0
(if syntaxes?2_0
id:val89_0
id:val113_0)))
(if sc_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((ids_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((id_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(add-scope
id_0
sc_0)
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
ids_0))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null val-idss_0))))
val-idss_0))))
(let ((val-rhss_0
(let ((val-rhss_0
(if syntaxes?2_0
val-rhs90_0
val-rhs114_0)))
(if (if rec?3_0 sc_0 #f)
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((rhs_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope
rhs_0
sc_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
val-rhss_0))))
val-rhss_0))))
(let ((val-clauses_0
(if syntaxes?2_0
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1
disarmed-s_0)
(syntax-e$1
disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((_0
(let ((s_2
(car
s_1)))
s_2)))
(call-with-values
(lambda ()
(let ((s_2
(cdr s_1)))
(let ((s_3
(if (syntax?$1
s_2)
(syntax-e$1
s_2)
s_2)))
(if (pair?
s_3)
(let ((_1
(let ((s_4
(car
s_3)))
s_4)))
(call-with-values
(lambda ()
(let ((s_4
(cdr
s_3)))
(let ((s_5
(if (syntax?$1
s_4)
(syntax-e$1
s_4)
s_4)))
(if (pair?
s_5)
(let ((clause149_0
(let ((s_6
(car
s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(let ((flat-s_0
(to-syntax-list.1
s_7)))
(if (not
flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0))))))
(let ((_2
(let ((s_6
(cdr
s_5)))
s_6)))
(let ((clause149_1
clause149_0))
(values
clause149_1
_2))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((clause147_0
_2)
(let ((_3
_1))
(values
_3
clause147_0
_2)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((_1
clause144_0
_2)
(let ((_3 _0))
(values
_3
_1
clause144_0
_2)))
(args
(raise-binding-result-arity-error
3
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((_0 _1 clause140_0 _2)
(values
#t
_0
_1
clause140_0
_2))
(args
(raise-binding-result-arity-error
4
args)))))
(case-lambda
((ok?_2 _0 _1 clause140_0 _2)
clause140_0)
(args
(raise-binding-result-arity-error
5
args))))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1
disarmed-s_0)
(syntax-e$1
disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((_0
(let ((s_2
(car
s_1)))
s_2)))
(call-with-values
(lambda ()
(let ((s_2
(cdr s_1)))
(let ((s_3
(if (syntax?$1
s_2)
(syntax-e$1
s_2)
s_2)))
(if (pair?
s_3)
(let ((clause157_0
(let ((s_4
(car
s_3)))
(let ((s_5
(if (syntax?$1
s_4)
(syntax-e$1
s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1
s_5)))
(if (not
flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0))))))
(let ((_1
(let ((s_4
(cdr
s_3)))
s_4)))
(let ((clause157_1
clause157_0))
(values
clause157_1
_1))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((clause155_0 _1)
(let ((_2 _0))
(values
_2
clause155_0
_1)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((_0 clause152_0 _1)
(values
#t
_0
clause152_0
_1))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_2 _0 clause152_0 _1)
clause152_0)
(args
(raise-binding-result-arity-error
4
args)))))))
(begin
(let ((temp126_0
(list
trans-idss_0
val-idss_0)))
(check-no-duplicate-ids.1
unsafe-undefined
temp126_0
phase_0
s_0
unsafe-undefined))
(let ((counter_0
(begin-unsafe
(root-expand-context/inner-counter
(root-expand-context/outer-inner
ctx_0)))))
(let ((local-sym_0
(if (begin-unsafe
(expand-context/inner-normalize-locals?
(root-expand-context/outer-inner
ctx_0)))
'loc
#f)))
(let ((trans-keyss_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((ids_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((id_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(add-local-binding!.1
frame-id_0
s_0
local-sym_0
id_0
phase_0
counter_0)
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
ids_0))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
trans-idss_0))))))
(let ((val-keyss_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((ids_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((id_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(if sc_0
(add-local-binding!.1
frame-id_0
s_0
local-sym_0
id_0
phase_0
counter_0)
(existing-binding-key
id_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner
ctx_0)))))
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
ids_0))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
val-idss_0))))))
(let ((bodys_0
(let ((bodys_0
(if syntaxes?2_0
body91_0
body115_0)))
(if sc_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(let ((new-body_0
(add-scope
body_0
sc_0)))
(if rec?3_0
(add-scope
new-body_0
body-sc_0)
new-body_0))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
bodys_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
'letX-renames
trans-idss_0
trans-rhss_0
val-idss_0
val-rhss_0
bodys_0)
(void)))
(begin
(if syntaxes?2_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
'prepare-env)
(void)))
(prepare-next-phase-namespace
ctx_0))
(void))
(let ((trans-valss_0
(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?
lst_1)
#f)
(let ((rhs_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((ids_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(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
'next)
(call-expand-observe
obs_0
'enter-bind))
(void)))
(let ((trans-val_0
(eval-for-syntaxes-binding
'letrec-syntaxes+values
rhs_0
ids_0
ctx_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
'exit-bind)
(void)))
trans-val_0)))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0
rest_1))))))
fold-var_0))))))
(for-loop_0
null
trans-rhss_0
trans-idss_0))))))
(let ((rec-val-env_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 ((keys_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((ids_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((env_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (env_1
lst_2
lst_3)
(begin
(if (if (pair?
lst_2)
(pair?
lst_3)
#f)
(let ((key_0
(unsafe-car
lst_2)))
(let ((rest_2
(unsafe-cdr
lst_2)))
(let ((id_0
(unsafe-car
lst_3)))
(let ((rest_3
(unsafe-cdr
lst_3)))
(let ((val_0
(local-variable1.1
id_0)))
(let ((env_2
(let ((env_2
(begin-unsafe
(hash-set
env_1
key_0
val_0))))
(values
env_2))))
(for-loop_1
env_2
rest_2
rest_3)))))))
env_1))))))
(for-loop_1
env_0
keys_0
ids_0)))))
(for-loop_0
env_1
rest_0
rest_1))))))
env_0))))))
(for-loop_0
(begin-unsafe
(expand-context/outer-env
ctx_0))
val-keyss_0
val-idss_0)))))
(let ((rec-env_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (env_0
lst_0
lst_1
lst_2)
(begin
(if (if (pair?
lst_0)
(if (pair?
lst_1)
(pair?
lst_2)
#f)
#f)
(let ((keys_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((vals_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((ids_0
(unsafe-car
lst_2)))
(let ((rest_2
(unsafe-cdr
lst_2)))
(let ((env_1
(let ((env_1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (env_1
lst_3
lst_4
lst_5)
(begin
(if (if (pair?
lst_3)
(if (pair?
lst_4)
(pair?
lst_5)
#f)
#f)
(let ((key_0
(unsafe-car
lst_3)))
(let ((rest_3
(unsafe-cdr
lst_3)))
(let ((val_0
(unsafe-car
lst_4)))
(let ((rest_4
(unsafe-cdr
lst_4)))
(let ((id_0
(unsafe-car
lst_5)))
(let ((rest_5
(unsafe-cdr
lst_5)))
(let ((env_2
(let ((env_2
(begin
(maybe-install-free=id-in-context!
val_0
id_0
phase_0
ctx_0)
(begin-unsafe
(hash-set
env_1
key_0
val_0)))))
(values
env_2))))
(for-loop_1
env_2
rest_3
rest_4
rest_5))))))))
env_1))))))
(for-loop_1
env_0
keys_0
vals_0
ids_0)))))
(values
env_1))))
(for-loop_0
env_1
rest_0
rest_1
rest_2))))))))
env_0))))))
(for-loop_0
rec-val-env_0
trans-keyss_0
trans-valss_0
trans-idss_0)))))
(begin
(if syntaxes?2_0
(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-group)
(void)))
(void))
(let ((expr-ctx_0
(as-expression-context
ctx_0)))
(let ((orig-rrs_0
(begin-unsafe
(expand-context/outer-reference-records
expr-ctx_0))))
(let ((rec-ctx_0
(if (expand-context/outer?
expr-ctx_0)
(let ((scopes172_0
(if sc_0
(let ((scopes_0
(cons
sc_0
(begin-unsafe
(expand-context/outer-scopes
ctx_0)))))
(if rec?3_0
(cons
body-sc_0
scopes_0)
scopes_0))
(begin-unsafe
(expand-context/outer-scopes
ctx_0)))))
(let ((reference-records173_0
(if split-by-reference?4_0
(cons
frame-id_0
orig-rrs_0)
orig-rrs_0)))
(let ((binding-layer174_0
(if sc_0
(increment-binding-layer
(cons
trans-idss_0
val-idss_0)
ctx_0
sc_0)
(begin-unsafe
(expand-context/outer-binding-layer
ctx_0)))))
(let ((inner175_0
(root-expand-context/outer-inner
expr-ctx_0)))
(let ((binding-layer174_1
binding-layer174_0)
(reference-records173_1
reference-records173_0)
(scopes172_1
scopes172_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?"
expr-ctx_0))))
(let ((letrec-values-id_0
(if (not
(begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0))))
(if syntaxes?2_0
(core-id
'letrec-values
phase_0)
let-values112_0)
#f)))
(let ((rebuild-s_0
(keep-as-needed.1
#f
#t
#f
ctx_0
s_0)))
(let ((val-name-idss_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((val-ids_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(reverse$1
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (fold-var_1
lst_1)
(begin
(if (pair?
lst_1)
(let ((val-id_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((fold-var_2
(let ((fold-var_2
(cons
(datum->syntax$1
#f
(syntax-e$1
val-id_0)
val-id_0
val-id_0)
fold-var_1)))
(values
fold-var_2))))
(for-loop_1
fold-var_2
rest_1))))
fold-var_1))))))
(for-loop_1
null
val-ids_0))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
val-idss_0))))
val-idss_0)))
(let ((get-body_0
(|#%name|
get-body
(lambda ()
(begin
(if (begin-unsafe
(expand-context/inner-parsing-expanded?
(root-expand-context/outer-inner
ctx_0)))
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((body_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(expand.1
#f
#f
body_0
rec-ctx_0)
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0
null
bodys_0))))
(let ((body-ctx_0
(if (expand-context/outer?
rec-ctx_0)
(let ((inner185_0
(root-expand-context/outer-inner
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?"
rec-ctx_0))))
(let ((temp182_0
(as-tail-context.1
ctx_0
body-ctx_0)))
(expand-body.1
rebuild-s_0
#f
bodys_0
temp182_0)))))))))
(let ((result-s_0
(if (not
split-by-reference?4_0)
(let ((clauses_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0
lst_0
lst_1
lst_2
lst_3)
(begin
(if (if (pair?
lst_0)
(if (pair?
lst_1)
(if (pair?
lst_2)
(pair?
lst_3)
#f)
#f)
#f)
(let ((ids_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((keys_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((rhs_0
(unsafe-car
lst_2)))
(let ((rest_2
(unsafe-cdr
lst_2)))
(let ((clause_0
(unsafe-car
lst_3)))
(let ((rest_3
(unsafe-cdr
lst_3)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(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 ((exp-rhs_0
(let ((temp189_0
(if rec?3_0
(as-named-context
rec-ctx_0
ids_0)
(as-named-context
expr-ctx_0
ids_0))))
(expand.1
#f
#f
rhs_0
temp189_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
(list
keys_0
exp-rhs_0)
(datum->syntax$1
#f
(list
ids_0
exp-rhs_0)
clause_0
clause_0))))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0
rest_1
rest_2
rest_3))))))))))
fold-var_0))))))
(for-loop_0
null
val-name-idss_0
val-keyss_0
val-rhss_0
val-clauses_0))))))
(let ((exp-body_0
(get-body_0)))
(begin
(if frame-id_0
(reference-record-clear!
frame-id_0)
(void))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
(if rec?3_0
(parsed-letrec-values18.1
rebuild-s_0
val-name-idss_0
clauses_0
exp-body_0)
(parsed-let-values17.1
rebuild-s_0
val-name-idss_0
clauses_0
exp-body_0))
(let ((temp191_0
(list*
letrec-values-id_0
clauses_0
exp-body_0)))
(rebuild.1
#t
rebuild-s_0
temp191_0))))))
(expand-and-split-bindings-by-reference.1
rec-ctx_0
frame-id_0
get-body_0
syntaxes?2_0
rebuild-s_0
#t
#t
val-idss_0
val-keyss_0
val-rhss_0
val-clauses_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
result-s_0
(attach-disappeared-transformer-bindings
result-s_0
trans-idss_0)))))))))))))))))))))))))))))))))
(args (raise-binding-result-arity-error 5 args)))))
(args (raise-binding-result-arity-error 7 args)))))))))))
(define effect_1922
(begin
(void
(add-core-form!*
'let-values
(make-let-values-form.1 'prim-let-values #f #f #f)))
(void)))
(define effect_2915
(begin
(void
(add-core-form!*
'letrec-values
(make-let-values-form.1 'prim-letrec-values #t #f #f)))
(void)))
(define effect_2432
(begin
(void
(add-core-form!*
'letrec-syntaxes+values
(make-let-values-form.1 'prim-letrec-syntaxes+values #t #t #t)))
(void)))
(define effect_2466
(begin
(void
(add-core-form!*
'|#%stratified-body|
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 '|prim-#%stratified| disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((|#%stratified-body212_0|
(let ((s_2 (car s_1))) s_2)))
(let ((body213_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(if (null? flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0)))))))
(let ((|#%stratified-body212_1|
|#%stratified-body212_0|))
(values |#%stratified-body212_1| body213_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((|#%stratified-body210_0| body211_0)
(values #t |#%stratified-body210_0| body211_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 |#%stratified-body210_0| body211_0)
(let ((rebuild-s_0 (keep-as-needed.1 #f #t #f ctx_0 s_0)))
(let ((exp-body_0
(expand-body.1 rebuild-s_0 #t body211_0 ctx_0)))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-begin12.1 rebuild-s_0 exp-body_0)
(let ((temp222_0
(if (null? (cdr exp-body_0))
(car exp-body_0)
(list*
(core-id
'begin
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0))))
exp-body_0))))
(rebuild.1 #t rebuild-s_0 temp222_0))))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_2533
(begin
(void
(add-core-form!*
'|#%datum|
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 '|prim-#%datum| disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((|#%datum225_0| (let ((s_2 (car s_1))) s_2)))
(let ((datum226_0 (let ((s_2 (cdr s_1))) s_2)))
(let ((|#%datum225_1| |#%datum225_0|))
(values |#%datum225_1| datum226_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((|#%datum223_0| datum224_0)
(values #t |#%datum223_0| datum224_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 |#%datum223_0| datum224_0)
(begin
(if (if (syntax?$1 datum224_0)
(keyword? (syntax-e$1 datum224_0))
#f)
(raise-syntax-error$1
'|#%datum|
"keyword misused as an expression"
#f
datum224_0)
(void))
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_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-quote14.1
(begin-unsafe #f)
(syntax->datum$1 datum224_0))
(syntax-track-origin$1
(let ((temp228_0
(list (core-id 'quote phase_0) datum224_0)))
(rebuild.1 #f s_0 temp228_0))
s_0
|#%datum223_0|)))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_2244
(begin
(void
(add-core-form!*
'|#%app|
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 '|prim-#%app| disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((|#%app232_0| (let ((s_2 (car s_1))) s_2)))
(let ((e233_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0))))))
(let ((|#%app232_1| |#%app232_0|))
(values |#%app232_1| e233_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((|#%app230_0| e231_0) (values #t |#%app230_0| e231_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 |#%app230_0| e231_0)
(if (null? e231_0)
(let ((phase_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-quote14.1 (begin-unsafe #f) null)
(let ((temp235_0 (list (core-id 'quote phase_0) null)))
(rebuild.1 #t s_0 temp235_0))))
(let ((keep-for-parsed?_0 keep-source-locations?))
(let ((rebuild-s_0
(keep-as-needed.1
#f
#f
keep-for-parsed?_0
ctx_0
s_0)))
(let ((prefixless_0 (cdr (syntax-e$1 disarmed-s_0))))
(let ((rebuild-prefixless_0
(if (syntax?$1 prefixless_0)
(keep-as-needed.1
#f
#f
keep-for-parsed?_0
ctx_0
prefixless_0)
#f)))
(let ((expr-ctx_0 (as-expression-context ctx_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
expr-ctx_0)))))
(if obs_0
(call-expand-observe obs_0 'next)
(void)))
(let ((rest-es_0 (cdr e231_0)))
(let ((exp-rator_0
(let ((temp242_0 (car e231_0)))
(expand.1
#f
#f
temp242_0
expr-ctx_0))))
(let ((exp-es_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((e_0
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
expr-ctx_0)))))
(if obs_0
(call-expand-observe
obs_0
'next)
(void)))
(expand.1
#f
#f
e_0
expr-ctx_0))
fold-var_0)))
(values
fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null rest-es_0))))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
(parsed-app7.1
(if rebuild-prefixless_0
rebuild-prefixless_0
rebuild-s_0)
exp-rator_0
exp-es_0)
(let ((exp-es_1
(cons exp-rator_0 exp-es_0)))
(let ((es_0
(if rebuild-prefixless_0
(rebuild.1
#t
rebuild-prefixless_0
exp-es_1)
exp-es_1)))
(let ((temp247_0
(cons |#%app230_0| es_0)))
(rebuild.1
#t
rebuild-s_0
temp247_0))))))))))))))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_2537
(begin
(void
(add-core-form!*
'quote
(lambda (s_0 ctx_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 'prim-quote #f) (void)))
(call-with-values
(lambda ()
(let ((s_1 (syntax-disarm$1 s_0)))
(call-with-values
(lambda ()
(let ((s_2 (if (syntax?$1 s_1) (syntax-e$1 s_1) s_1)))
(if (pair? s_2)
(let ((quote252_0 (let ((s_3 (car s_2))) s_3)))
(let ((datum253_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 ((datum254_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"
s_1)))))
(case-lambda
(()
(let ((datum254_1 datum254_0))
(values datum254_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
s_1))))))
(let ((quote252_1 quote252_0))
(values quote252_1 datum253_0))))
(raise-syntax-error$1 #f "bad syntax" s_1))))
(case-lambda
((quote250_0 datum251_0) (values #t quote250_0 datum251_0))
(args (raise-binding-result-arity-error 2 args))))))
(case-lambda
((ok?_0 quote250_0 datum251_0)
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-quote14.1
(begin-unsafe #f)
(syntax->datum$1 datum251_0))
s_0))
(args (raise-binding-result-arity-error 3 args))))))))
(void)))
(define effect_2669
(begin
(void
(add-core-form!*
'quote-syntax
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-quote-syntax disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(if (let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(if (let ((s_2 (car s_1))) #t)
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(if (let ((s_4 (car s_3))) #t)
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(if (let ((s_6 (car s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(eq? kw2186 s_7)))
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(null? s_7)))
#f)
#f)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(let ((quote-syntax257_0 (let ((s_2 (car s_1))) s_2)))
(let ((datum258_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((datum259_0
(let ((s_4 (car s_3))) s_4)))
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(call-with-values
(lambda ()
(let ((s_6 (car s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(values))))
(case-lambda
(()
(call-with-values
(lambda ()
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(values))))
(case-lambda
(() (let () (values)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
0
args)))))))
(case-lambda
(()
(let ((datum259_1 datum259_0))
(values datum259_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((quote-syntax257_1 quote-syntax257_0))
(values quote-syntax257_1 datum258_0))))))
(case-lambda
((quote-syntax255_0 datum256_0)
(values #t quote-syntax255_0 datum256_0))
(args (raise-binding-result-arity-error 2 args))))
(values #f #f #f)))
(case-lambda
((ok?_0 quote-syntax255_0 datum256_0)
(call-with-values
(lambda ()
(if (if (not ok?_0) #t #f)
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((quote-syntax262_0
(let ((s_2 (car s_1))) s_2)))
(let ((datum263_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(let ((datum264_0
(let ((s_4 (car s_3))) s_4)))
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (null? s_5)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((datum264_1 datum264_0))
(values datum264_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((quote-syntax262_1 quote-syntax262_0))
(values quote-syntax262_1 datum263_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((quote-syntax260_0 datum261_0)
(values #t quote-syntax260_0 datum261_0))
(args (raise-binding-result-arity-error 2 args))))
(values #f #f #f)))
(case-lambda
((ok?_1 quote-syntax260_0 datum261_0)
(if ok?_0
(begin
(reference-records-all-used!
(begin-unsafe
(expand-context/outer-reference-records ctx_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(let ((_1
(let ((s_4 (car s_3))) s_4)))
(let ((kw272_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1
s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(let ((kw273_0
(let ((s_6
(car
s_5)))
s_6)))
(call-with-values
(lambda ()
(let ((s_6
(cdr
s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (null?
s_7)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((kw273_1
kw273_0))
(values
kw273_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((_2 _1))
(values _2 kw272_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((_1 kw270_0)
(let ((_2 _0)) (values _2 _1 kw270_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((_0 _1 kw267_0) (values #t _0 _1 kw267_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_2 _0 _1 kw267_0)
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-quote-syntax15.1
(begin-unsafe #f)
datum256_0)
(let ((temp275_0
(list quote-syntax255_0 datum256_0 kw267_0)))
(rebuild.1 #t s_0 temp275_0))))
(args (raise-binding-result-arity-error 4 args)))))
(let ((use-site-scopes_0
(begin-unsafe
(root-expand-context/outer-use-site-scopes
ctx_0))))
(let ((datum-s_0
(let ((app_0
(remove-scopes
datum261_0
(begin-unsafe
(expand-context/outer-scopes ctx_0)))))
(remove-scopes
app_0
(if use-site-scopes_0
(unbox use-site-scopes_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-quote-syntax15.1 (begin-unsafe #f) datum-s_0)
(let ((temp277_0 (list quote-syntax260_0 datum-s_0)))
(rebuild.1 #t s_0 temp277_0)))))))
(args (raise-binding-result-arity-error 3 args)))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_3050
(begin
(void
(add-core-form!*
'if
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-if disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(if (let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(if (let ((s_2 (car s_1))) #t)
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(if (let ((s_4 (car s_3))) #t)
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(if (let ((s_6 (car s_5))) #t)
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(null? s_7)))
#f)
#f)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(let ((_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(let ((_1 (let ((s_4 (car s_3))) s_4)))
(let ((_2
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((_2
(let ((s_6 (car s_5)))
s_6)))
(call-with-values
(lambda ()
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1 s_6)
(syntax-e$1 s_6)
s_6)))
(values))))
(case-lambda
(()
(let ((_3 _2)) (values _3)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((_3 _1)) (values _3 _2)))))))
(case-lambda
((_1 _2) (let ((_3 _0)) (values _3 _1 _2)))
(args (raise-binding-result-arity-error 2 args)))))))
(case-lambda
((_0 _1 _2) (values #t _0 _1 _2))
(args (raise-binding-result-arity-error 3 args))))
(values #f #f #f #f)))
(case-lambda
((ok?_0 _0 _1 _2)
(begin
(if ok?_0
(raise-syntax-error$1
#f
"missing an \"else\" expression"
s_0)
(void))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((if291_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(let ((tst295_0
(let ((s_4 (car s_3))) s_4)))
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(let ((thn298_0
(let ((s_6 (car s_5)))
s_6)))
(let ((els299_0
(let ((s_6
(cdr s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (pair? s_7)
(let ((els300_0
(let ((s_8
(car
s_7)))
s_8)))
(call-with-values
(lambda ()
(let ((s_8
(cdr
s_7)))
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(if (null?
s_9)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((els300_1
els300_0))
(values
els300_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((thn298_1 thn298_0))
(values
thn298_1
els299_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((thn296_0 els297_0)
(let ((tst295_1 tst295_0))
(values
tst295_1
thn296_0
els297_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((tst292_0 thn293_0 els294_0)
(let ((if291_1 if291_0))
(values if291_1 tst292_0 thn293_0 els294_0)))
(args
(raise-binding-result-arity-error 3 args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((if287_0 tst288_0 thn289_0 els290_0)
(values #t if287_0 tst288_0 thn289_0 els290_0))
(args (raise-binding-result-arity-error 4 args)))))
(case-lambda
((ok?_1 if287_0 tst288_0 thn289_0 els290_0)
(let ((expr-ctx_0 (as-expression-context ctx_0)))
(let ((tail-ctx_0 (as-tail-context.1 ctx_0 expr-ctx_0)))
(let ((rebuild-s_0
(keep-as-needed.1 #f #f #f ctx_0 s_0)))
(let ((exp-tst_0
(expand.1 #f #f tst288_0 expr-ctx_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 ((exp-thn_0
(expand.1 #f #f thn289_0 tail-ctx_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 ((exp-els_0
(expand.1 #f #f els290_0 tail-ctx_0)))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx_0)))
(parsed-if8.1
rebuild-s_0
exp-tst_0
exp-thn_0
exp-els_0)
(let ((temp312_0
(list
if287_0
exp-tst_0
exp-thn_0
exp-els_0)))
(rebuild.1
#t
rebuild-s_0
temp312_0))))))))))))
(args (raise-binding-result-arity-error 5 args))))))
(args (raise-binding-result-arity-error 4 args)))))))))
(void)))
(define effect_2971
(begin
(void
(add-core-form!*
'with-continuation-mark
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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
'prim-with-continuation-mark
disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((with-continuation-mark317_0
(let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(let ((key321_0 (let ((s_4 (car s_3))) s_4)))
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(let ((val324_0
(let ((s_6 (car s_5)))
s_6)))
(let ((body325_0
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (pair? s_7)
(let ((body326_0
(let ((s_8
(car
s_7)))
s_8)))
(call-with-values
(lambda ()
(let ((s_8
(cdr
s_7)))
(let ((s_9
(if (syntax?$1
s_8)
(syntax-e$1
s_8)
s_8)))
(if (null?
s_9)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((body326_1
body326_0))
(values
body326_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((val324_1 val324_0))
(values
val324_1
body325_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((val322_0 body323_0)
(let ((key321_1 key321_0))
(values key321_1 val322_0 body323_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((key318_0 val319_0 body320_0)
(let ((with-continuation-mark317_1
with-continuation-mark317_0))
(values
with-continuation-mark317_1
key318_0
val319_0
body320_0)))
(args (raise-binding-result-arity-error 3 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((with-continuation-mark313_0 key314_0 val315_0 body316_0)
(values
#t
with-continuation-mark313_0
key314_0
val315_0
body316_0))
(args (raise-binding-result-arity-error 4 args)))))
(case-lambda
((ok?_0 with-continuation-mark313_0 key314_0 val315_0 body316_0)
(let ((expr-ctx_0 (as-expression-context ctx_0)))
(let ((rebuild-s_0 (keep-as-needed.1 #f #f #f ctx_0 s_0)))
(let ((exp-key_0 (expand.1 #f #f key314_0 expr-ctx_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 ((exp-val_0 (expand.1 #f #f val315_0 expr-ctx_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 ((exp-body_0
(let ((temp334_0
(as-tail-context.1 ctx_0 expr-ctx_0)))
(expand.1 #f #f body316_0 temp334_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-with-continuation-mark10.1
rebuild-s_0
exp-key_0
exp-val_0
exp-body_0)
(let ((temp338_0
(list
with-continuation-mark313_0
exp-key_0
exp-val_0
exp-body_0)))
(rebuild.1 #t rebuild-s_0 temp338_0)))))))))))
(args (raise-binding-result-arity-error 5 args)))))))))
(void)))
(define make-begin.1
(|#%name|
make-begin
(lambda (last-is-tail?10_0 log-tag12_0 parsed-begin13_0)
(begin
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 log-tag12_0 disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((begin341_0 (let ((s_2 (car s_1))) s_2)))
(let ((e342_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(if (null? flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0)))))))
(let ((begin341_1 begin341_0))
(values begin341_1 e342_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((begin339_0 e340_0) (values #t begin339_0 e340_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 begin339_0 e340_0)
(let ((expr-ctx_0
(if last-is-tail?10_0
(as-begin-expression-context ctx_0)
(as-expression-context ctx_0))))
(let ((rebuild-s_0 (keep-as-needed.1 #f #f #f ctx_0 s_0)))
(let ((exp-es_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (es_0)
(begin
(if (null? es_0)
null
(let ((rest-es_0 (cdr es_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 ((app_0
(let ((temp345_0 (car es_0)))
(let ((temp346_0
(if (if last-is-tail?10_0
(null?
rest-es_0)
#f)
(as-tail-context.1
ctx_0
expr-ctx_0)
expr-ctx_0)))
(let ((temp345_1
temp345_0))
(expand.1
#f
#f
temp345_1
temp346_0))))))
(cons
app_0
(loop_0 rest-es_0)))))))))))
(loop_0 e340_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(|#%app| parsed-begin13_0 rebuild-s_0 exp-es_0)
(let ((temp350_0 (cons begin339_0 exp-es_0)))
(rebuild.1 #t rebuild-s_0 temp350_0)))))))
(args (raise-binding-result-arity-error 3 args)))))))))))
(define effect_2494
(begin
(void
(add-core-form!*
'begin
(let ((nonempty-begin_0 (make-begin.1 #t 'prim-begin parsed-begin12.1)))
(lambda (s_0 ctx_0)
(let ((context_0
(begin-unsafe (expand-context/outer-context ctx_0))))
(if (let ((or-part_0 (eq? context_0 'top-level)))
(if or-part_0 or-part_0 (eq? context_0 'module)))
(let ((disarmed-s_0 (syntax-disarm$1 s_0)))
(call-with-values
(lambda ()
(if (let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(if (let ((s_2 (car s_1))) #t)
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(null? s_3)))
#f)
#f))
(let ((begin354_0
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(let ((begin355_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(values))))
(case-lambda
(()
(let ((begin355_1 begin355_0))
(values begin355_1)))
(args
(raise-binding-result-arity-error
0
args))))))))
(values #t begin354_0))
(values #f #f)))
(case-lambda
((ok?_0 begin354_0)
(if ok?_0 s_0 (|#%app| nonempty-begin_0 s_0 ctx_0)))
(args (raise-binding-result-arity-error 2 args)))))
(|#%app| nonempty-begin_0 s_0 ctx_0)))))))
(void)))
(define effect_2641
(begin
(void
(add-core-form!*
'begin0
(make-begin.1 #f 'prim-begin0 parsed-begin013.1)))
(void)))
(define register-eventual-variable!?
(lambda (id_0 ctx_0)
(if (if (begin-unsafe (expand-context/outer-need-eventually-defined ctx_0))
(>=
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))
1)
#f)
(begin
(let ((ht_0
(begin-unsafe
(expand-context/outer-need-eventually-defined ctx_0))))
(let ((key_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((xform_0 (lambda (l_0) (cons id_0 l_0))))
(begin-unsafe
(do-hash-update
'hash-update!
#t
hash-set!
ht_0
key_0
xform_0
null)))))
#t)
#f)))
(define effect_2283
(begin
(void
(add-core-form!*
'|#%top|
(let ((...nder/expand/expr.rkt:600:1_0
(|#%name|
...nder/expand/expr.rkt:600:1
(lambda (s360_0 ctx361_0 implicit-omitted?359_0)
(begin
(let ((disarmed-s_0 (syntax-disarm$1 s360_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx361_0)))))
(if obs_0
(call-expand-observe
obs_0
'|prim-#%top|
disarmed-s_0)
(void)))
(let ((id_0
(if implicit-omitted?359_0
s360_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 ((|#%top364_0|
(let ((s_1 (car s_0))) s_1)))
(let ((id365_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 ((|#%top364_1| |#%top364_0|))
(values |#%top364_1| id365_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))
(case-lambda
((|#%top362_0| id363_0)
(values #t |#%top362_0| id363_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 |#%top362_0| id363_0) id363_0)
(args
(raise-binding-result-arity-error
3
args)))))))
(let ((temp367_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx361_0)))))
(let ((b_0
(resolve+shift.1
'ambiguous
#f
null
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)
(eq?
(module-binding-module b_0)
(begin-unsafe
(root-expand-context/inner-self-mpi
(root-expand-context/outer-inner
ctx361_0))))
#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 ((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
((s_0 ctx_0) (begin (...nder/expand/expr.rkt:600:1_0 s_0 ctx_0 #f)))
((s_0 ctx_0 implicit-omitted?359_0)
(...nder/expand/expr.rkt:600:1_0
s_0
ctx_0
implicit-omitted?359_0)))))))
(void)))
(define effect_2326
(begin
(void
(add-core-form!*
'set!
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-set! disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((set!380_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(let ((id383_0
(let ((s_4 (car s_3)))
(if (let ((or-part_0
(if (syntax?$1 s_4)
(symbol?
(syntax-e$1 s_4))
#f)))
(if or-part_0
or-part_0
(symbol? s_4)))
s_4
(raise-syntax-error$1
#f
"not an identifier"
disarmed-s_0
s_4)))))
(let ((rhs384_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(let ((rhs385_0
(let ((s_6 (car s_5)))
s_6)))
(call-with-values
(lambda ()
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (null? s_7)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((rhs385_1 rhs385_0))
(values rhs385_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((id383_1 id383_0))
(values id383_1 rhs384_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((id381_0 rhs382_0)
(let ((set!380_1 set!380_0))
(values set!380_1 id381_0 rhs382_0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((set!377_0 id378_0 rhs379_0)
(values #t set!377_0 id378_0 rhs379_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 set!377_0 id378_0 rhs379_0)
(letrec*
((rename-loop_0
(|#%name|
rename-loop
(lambda (id_0 from-rename?_0)
(begin
(let ((temp387_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
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
(inside-module-context?
(module-binding-module binding_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?
(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?
(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)))
(define substitute-set!-rename
(lambda (s_0 disarmed-s_0 set!-id_0 id_0 rhs-s_0 from-rename?_0 ctx_0)
(if from-rename?_0
(syntax-rearm$1
(datum->syntax$1
disarmed-s_0
(list set!-id_0 id_0 rhs-s_0)
disarmed-s_0
disarmed-s_0)
s_0)
s_0)))
(define effect_2374
(begin
(void
(add-core-form!*
'|#%variable-reference|
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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
'|prim-#%variable-reference|
disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(if (let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(if (let ((s_2 (car s_1))) #t)
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2) (syntax-e$1 s_2) s_2)))
(if (pair? s_3)
(if (let ((s_4 (car s_3)))
(let ((or-part_0
(if (syntax?$1 s_4)
(symbol? (syntax-e$1 s_4))
#f)))
(if or-part_0 or-part_0 (symbol? s_4))))
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(null? s_5)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(let ((|#%variable-reference417_0|
(let ((s_2 (car s_1))) s_2)))
(let ((id418_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((id419_0 (let ((s_4 (car s_3))) s_4)))
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(values))))
(case-lambda
(()
(let ((id419_1 id419_0))
(values id419_1)))
(args
(raise-binding-result-arity-error
0
args)))))))))
(let ((|#%variable-reference417_1|
|#%variable-reference417_0|))
(values |#%variable-reference417_1| id418_0))))))
(case-lambda
((|#%variable-reference415_0| id416_0)
(values #t |#%variable-reference415_0| id416_0))
(args (raise-binding-result-arity-error 2 args))))
(values #f #f #f)))
(case-lambda
((ok?_0 |#%variable-reference415_0| id416_0)
(call-with-values
(lambda ()
(if (if (not ok?_0)
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(if (let ((s_2 (car s_1))) #t)
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(if (let ((s_4 (car s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(if (let ((s_6 (car s_5))) #t)
(let ((s_6 (cdr s_5)))
(let ((or-part_0
(if (syntax?$1 s_6)
(symbol?
(syntax-e$1 s_6))
#f)))
(if or-part_0
or-part_0
(symbol? s_6))))
#f)
#f)))
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(null? s_5)))
#f)
#f)))
#f)
#f))
#f)
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(let ((|#%variable-reference423_0|
(let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(call-with-values
(lambda ()
(let ((s_4 (car s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((|#%top428_0|
(let ((s_6 (car s_5))) s_6)))
(let ((id429_0
(let ((s_6 (cdr s_5))) s_6)))
(let ((|#%top428_1| |#%top428_0|))
(values
|#%top428_1|
id429_0)))))))
(case-lambda
((|#%top426_0| id427_0)
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(values))))
(case-lambda
(()
(let ((|#%top426_1| |#%top426_0|)
(id427_1 id427_0))
(values |#%top426_1| id427_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args)))))))
(case-lambda
((|#%top424_0| id425_0)
(let ((|#%variable-reference423_1|
|#%variable-reference423_0|))
(values
|#%variable-reference423_1|
|#%top424_0|
id425_0)))
(args
(raise-binding-result-arity-error 2 args)))))))
(case-lambda
((|#%variable-reference420_0| |#%top421_0| id422_0)
(values
#t
|#%variable-reference420_0|
|#%top421_0|
id422_0))
(args (raise-binding-result-arity-error 3 args))))
(values #f #f #f #f)))
(case-lambda
((ok?_1 |#%variable-reference420_0| |#%top421_0| id422_0)
(call-with-values
(lambda ()
(if (if (not (if ok?_0 ok?_0 ok?_1)) #t #f)
(let ((|#%variable-reference430_0|
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((|#%variable-reference431_0|
(let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (null? s_3)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((|#%variable-reference431_1|
|#%variable-reference431_0|))
(values |#%variable-reference431_1|)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(values #t |#%variable-reference430_0|))
(values #f #f)))
(case-lambda
((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 ((temp433_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((binding_0
(resolve+shift.1
'ambiguous
#f
null
unsafe-undefined
#f
var-id_0
temp433_0)))
(begin
(if (eq? binding_0 'ambiguous)
(raise-ambiguous-error var-id_0 ctx_0)
(void))
(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
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
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)))
(|parsed-#%variable-reference11.1|
(begin-unsafe #f)
#f)
s_0)))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 4 args)))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_1916
(begin
(void
(add-core-form!*
'|#%expression|
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 '|prim-#%expression| disarmed-s_0)
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((|#%expression442_0| (let ((s_2 (car s_1))) s_2)))
(let ((e443_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(let ((e444_0
(let ((s_4 (car s_3))) s_4)))
(call-with-values
(lambda ()
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (null? s_5)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((e444_1 e444_0))
(values e444_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((|#%expression442_1| |#%expression442_0|))
(values |#%expression442_1| e443_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((|#%expression440_0| e441_0)
(values #t |#%expression440_0| e441_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 |#%expression440_0| e441_0)
(let ((rebuild-s_0 (keep-as-needed.1 #t #f #f ctx_0 s_0)))
(let ((exp-e_0
(let ((temp449_0
(let ((temp450_0 (as-expression-context ctx_0)))
(as-tail-context.1 ctx_0 temp450_0))))
(expand.1 #f #f e441_0 temp449_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
exp-e_0
(if (let ((or-part_0
(if (begin-unsafe
(expand-context/inner-in-local-expand?
(root-expand-context/outer-inner ctx_0)))
(begin-unsafe
(|expand-context/inner-keep-#%expression?|
(root-expand-context/outer-inner ctx_0)))
#f)))
(if or-part_0
or-part_0
(eq?
'top-level
(begin-unsafe
(expand-context/outer-context ctx_0)))))
(let ((temp453_0 (list |#%expression440_0| exp-e_0)))
(rebuild.1 #t rebuild-s_0 temp453_0))
(let ((result-s_0
(syntax-track-origin$1 exp-e_0 rebuild-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 'tag result-s_0)
(void)))
result-s_0)))))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_2926
(begin
(void
(add-core-form!*
'unquote
(lambda (s_0 ctx_0) (raise-syntax-error$1 #f "not in quasiquote" s_0))))
(void)))
(define effect_2058
(begin
(void
(add-core-form!*
'unquote-splicing
(lambda (s_0 ctx_0) (raise-syntax-error$1 #f "not in quasiquote" s_0))))
(void)))
(define binding-for-transformer?
(lambda (b_0 id_0 at-phase_0 ns_0)
(if (not at-phase_0)
(let ((m_0
(namespace->module
ns_0
(1/module-path-index-resolve
(module-binding-nominal-module b_0)))))
(let ((b/p_0
(let ((app_0
(hash-ref
(module-provides m_0)
(module-binding-nominal-phase b_0)
hash2610)))
(hash-ref app_0 (module-binding-nominal-sym b_0) #f))))
(provided-as-transformer? b/p_0)))
(begin
(namespace-visit-available-modules!
ns_0
(+ at-phase_0 (module-binding-phase b_0)))
(call-with-values
(lambda ()
(binding-lookup.1 #f #f b_0 empty-env null ns_0 at-phase_0 id_0))
(case-lambda
((val_0 primitive?_0 insp_0 protected?_0) (not (variable? val_0)))
(args (raise-binding-result-arity-error 4 args))))))))
(define layers '(raw phaseless id))
(define provide-form-name 'provide)
(define parse-and-expand-provides!
(lambda (specs_0 orig-s_0 rp_0 self_0 phase_0 ctx_0)
(let ((ns_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))))
(letrec*
((loop_0
(|#%name|
loop
(lambda (specs_1 at-phase_0 protected?_0 layer_0)
(begin
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (track-stxes_0 exp-specs_0 lst_0)
(begin
(if (pair? lst_0)
(let ((spec_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((disarmed-spec_0
(syntax-disarm$1 spec_0)))
(let ((fm_0
(if (pair?
(syntax-e$1
disarmed-spec_0))
(if (identifier?
(car
(syntax-e$1
disarmed-spec_0)))
(syntax-e$1
(car
(syntax-e$1
disarmed-spec_0)))
#f)
#f)))
(let ((check-nested_0
(|#%name|
check-nested
(lambda (want-layer_0)
(begin
(if (member
want-layer_0
(member
layer_0
layers))
(void)
(raise-syntax-error$1
'provide
(format
"nested `~a' not allowed"
fm_0)
orig-s_0
spec_0)))))))
(let ((index_0
(if (symbol? fm_0)
(hash-ref
hash2294
fm_0
(lambda () 0))
0)))
(if (unsafe-fx< index_0 6)
(if (unsafe-fx<
index_0
2)
(if (unsafe-fx<
index_0
1)
(if (identifier?
spec_0)
(begin
(parse-identifier!
spec_0
orig-s_0
(syntax-e$1
spec_0)
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list spec_0)))
(raise-syntax-error$1
'provide
"bad syntax"
orig-s_0
spec_0))
(begin
(check-nested_0
'raw)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((for-meta6_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 ((phase-level9_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((spec10_0
(let ((s_3
(cdr
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-spec_0)
flat-s_0))))))
(let ((phase-level9_1
phase-level9_0))
(values
phase-level9_1
spec10_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((phase-level7_0
spec8_0)
(let ((for-meta6_1
for-meta6_0))
(values
for-meta6_1
phase-level7_0
spec8_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((for-meta3_0
phase-level4_0
spec5_0)
(values
#t
for-meta3_0
phase-level4_0
spec5_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
for-meta3_0
phase-level4_0
spec5_0)
(let ((p_0
(syntax-e$1
phase-level4_0)))
(begin
(if (phase?
p_0)
(void)
(raise-syntax-error$1
'provide
"bad `for-meta' phase"
orig-s_0
spec_0))
(call-with-values
(lambda ()
(loop_0
spec5_0
(phase+
p_0
at-phase_0)
protected?_0
'phaseless))
(case-lambda
((track-stxes_1
exp-specs_1)
(values
null
(list
(syntax-track-origin*
track-stxes_1
(let ((temp12_0
(list*
for-meta3_0
phase-level4_0
exp-specs_1)))
(rebuild.1
#t
spec_0
temp12_0))))))
(args
(raise-binding-result-arity-error
2
args)))))))
(args
(raise-binding-result-arity-error
4
args))))))
(if (unsafe-fx<
index_0
3)
(begin
(check-nested_0
'raw)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((for-syntax15_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((spec16_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-spec_0)
flat-s_0))))))
(let ((for-syntax15_1
for-syntax15_0))
(values
for-syntax15_1
spec16_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((for-syntax13_0
spec14_0)
(values
#t
for-syntax13_0
spec14_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
for-syntax13_0
spec14_0)
(call-with-values
(lambda ()
(loop_0
spec14_0
(phase+
1
at-phase_0)
protected?_0
'phaseless))
(case-lambda
((track-stxes_1
exp-specs_1)
(values
null
(list
(syntax-track-origin*
track-stxes_1
(let ((temp18_0
(list*
for-syntax13_0
exp-specs_1)))
(rebuild.1
#t
spec_0
temp18_0))))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
3
args)))))
(if (unsafe-fx<
index_0
4)
(begin
(check-nested_0
'raw)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((for-label21_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((spec22_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-spec_0)
flat-s_0))))))
(let ((for-label21_1
for-label21_0))
(values
for-label21_1
spec22_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((for-label19_0
spec20_0)
(values
#t
for-label19_0
spec20_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
for-label19_0
spec20_0)
(call-with-values
(lambda ()
(loop_0
spec20_0
#f
protected?_0
'phaseless))
(case-lambda
((track-stxes_1
exp-specs_1)
(values
null
(list
(syntax-track-origin*
track-stxes_1
(let ((temp24_0
(list*
for-label19_0
exp-specs_1)))
(rebuild.1
#t
spec_0
temp24_0))))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
3
args)))))
(if (unsafe-fx<
index_0
5)
(begin
(check-nested_0
'phaseless)
(begin
(if protected?_0
(raise-syntax-error$1
'provide
"nested `protect' not allowed"
orig-s_0
spec_0)
(void))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((protect27_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((p-spec28_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-spec_0)
flat-s_0))))))
(let ((protect27_1
protect27_0))
(values
protect27_1
p-spec28_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((protect25_0
p-spec26_0)
(values
#t
protect25_0
p-spec26_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
protect25_0
p-spec26_0)
(call-with-values
(lambda ()
(loop_0
p-spec26_0
at-phase_0
#t
layer_0))
(case-lambda
((track-stxes_1
exp-specs_1)
(values
null
(list
(syntax-track-origin*
track-stxes_1
(let ((temp30_0
(list*
protect25_0
exp-specs_1)))
(rebuild.1
#t
spec_0
temp30_0))))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
3
args))))))
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((rename34_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 ((id:from37_0
(let ((s_3
(car
s_2)))
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
disarmed-spec_0
s_3)))))
(let ((id:to38_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 ((id:to39_0
(let ((s_5
(car
s_4)))
(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-spec_0
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-spec_0)))))
(case-lambda
(()
(let ((id:to39_1
id:to39_0))
(values
id:to39_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))))
(let ((id:from37_1
id:from37_0))
(values
id:from37_1
id:to38_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((id:from35_0
id:to36_0)
(let ((rename34_1
rename34_0))
(values
rename34_1
id:from35_0
id:to36_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((rename31_0
id:from32_0
id:to33_0)
(values
#t
rename31_0
id:from32_0
id:to33_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
rename31_0
id:from32_0
id:to33_0)
(begin
(parse-identifier!
id:from32_0
orig-s_0
(syntax-e$1
id:to33_0)
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
4
args)))))))))
(if (unsafe-fx<
index_0
9)
(if (unsafe-fx<
index_0
7)
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((struct43_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 ((id:struct46_0
(let ((s_3
(car
s_2)))
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
disarmed-spec_0
s_3)))))
(let ((id:field47_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 ((id:field48_0
(let ((s_5
(car
s_4)))
(let ((s_6
(if (syntax?$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"
disarmed-spec_0)
(let ((id:field_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id:field_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_7
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id:field_1
(let ((id:field_1
(let ((id:field49_0
(if (let ((or-part_0
(if (syntax?$1
s_7)
(symbol?
(syntax-e$1
s_7))
#f)))
(if or-part_0
or-part_0
(symbol?
s_7)))
s_7
(raise-syntax-error$1
#f
"not an identifier"
disarmed-spec_0
s_7))))
(cons
id:field49_0
id:field_0))))
(values
id:field_1))))
(for-loop_1
id:field_1
rest_1))))
id:field_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id:field_0))))))))
(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-spec_0)))))
(case-lambda
(()
(let ((id:field48_1
id:field48_0))
(values
id:field48_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))))
(let ((id:struct46_1
id:struct46_0))
(values
id:struct46_1
id:field47_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((id:struct44_0
id:field45_0)
(let ((struct43_1
struct43_0))
(values
struct43_1
id:struct44_0
id:field45_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((struct40_0
id:struct41_0
id:field42_0)
(values
#t
struct40_0
id:struct41_0
id:field42_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
struct40_0
id:struct41_0
id:field42_0)
(begin
(parse-struct!
id:struct41_0
orig-s_0
id:field42_0
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
4
args)))))
(if (unsafe-fx<
index_0
8)
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((all-from52_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((mod-path53_0
(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 ((mod-path54_0
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?$1
s_3)
(syntax-e$1
s_3)
s_3)))
(if (null?
s_4)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
(()
(let ((mod-path54_1
mod-path54_0))
(values
mod-path54_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))))
(let ((all-from52_1
all-from52_0))
(values
all-from52_1
mod-path53_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((all-from50_0
mod-path51_0)
(values
#t
all-from50_0
mod-path51_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
all-from50_0
mod-path51_0)
(begin
(parse-all-from
mod-path51_0
orig-s_0
self_0
null
at-phase_0
ns_0
rp_0
protected?_0
ctx_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
3
args)))))
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((all-from-except58_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 ((mod-path61_0
(let ((s_3
(car
s_2)))
s_3)))
(let ((id62_0
(let ((s_3
(cdr
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-spec_0)
(let ((id_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_5
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_1
(let ((id_1
(let ((id63_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-spec_0
s_5))))
(cons
id63_0
id_0))))
(values
id_1))))
(for-loop_1
id_1
rest_1))))
id_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id_0))))))))
(let ((mod-path61_1
mod-path61_0))
(values
mod-path61_1
id62_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((mod-path59_0
id60_0)
(let ((all-from-except58_1
all-from-except58_0))
(values
all-from-except58_1
mod-path59_0
id60_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((all-from-except55_0
mod-path56_0
id57_0)
(values
#t
all-from-except55_0
mod-path56_0
id57_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
all-from-except55_0
mod-path56_0
id57_0)
(begin
(parse-all-from
mod-path56_0
orig-s_0
self_0
id57_0
at-phase_0
ns_0
rp_0
protected?_0
ctx_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
4
args)))))))
(if (unsafe-fx<
index_0
11)
(if (unsafe-fx<
index_0
10)
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(let ((all-defined64_0
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((all-defined65_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 (null?
s_2)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
(()
(let ((all-defined65_1
all-defined65_0))
(values
all-defined65_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(values
#t
all-defined64_0)))
(case-lambda
((ok?_0
all-defined64_0)
(begin
(parse-all-from-module
self_0
spec_0
orig-s_0
null
#f
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
2
args)))))
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((all-defined-except68_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((id69_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-spec_0)
(let ((id_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_3
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_1
(let ((id_1
(let ((id70_0
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
disarmed-spec_0
s_3))))
(cons
id70_0
id_0))))
(values
id_1))))
(for-loop_1
id_1
rest_1))))
id_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id_0))))))))
(let ((all-defined-except68_1
all-defined-except68_0))
(values
all-defined-except68_1
id69_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((all-defined-except66_0
id67_0)
(values
#t
all-defined-except66_0
id67_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
all-defined-except66_0
id67_0)
(begin
(parse-all-from-module
self_0
spec_0
orig-s_0
id67_0
#f
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
3
args))))))
(if (unsafe-fx<
index_0
12)
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((prefix-all-defined73_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((id:prefix74_0
(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 ((id:prefix75_0
(let ((s_3
(car
s_2)))
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
disarmed-spec_0
s_3)))))
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?$1
s_3)
(syntax-e$1
s_3)
s_3)))
(if (null?
s_4)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
(()
(let ((id:prefix75_1
id:prefix75_0))
(values
id:prefix75_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))))
(let ((prefix-all-defined73_1
prefix-all-defined73_0))
(values
prefix-all-defined73_1
id:prefix74_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((prefix-all-defined71_0
id:prefix72_0)
(values
#t
prefix-all-defined71_0
id:prefix72_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0
prefix-all-defined71_0
id:prefix72_0)
(begin
(parse-all-from-module
self_0
spec_0
orig-s_0
null
(syntax-e$1
id:prefix72_0)
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
3
args)))))
(if (unsafe-fx<
index_0
13)
(begin
(check-nested_0
'phaseless)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((prefix-all-defined-except79_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 ((id:prefix82_0
(let ((s_3
(car
s_2)))
(if (let ((or-part_0
(if (syntax?$1
s_3)
(symbol?
(syntax-e$1
s_3))
#f)))
(if or-part_0
or-part_0
(symbol?
s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
disarmed-spec_0
s_3)))))
(let ((id83_0
(let ((s_3
(cdr
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-spec_0)
(let ((id_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (id_0
lst_1)
(begin
(if (pair?
lst_1)
(let ((s_5
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_1
(let ((id_1
(let ((id84_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-spec_0
s_5))))
(cons
id84_0
id_0))))
(values
id_1))))
(for-loop_1
id_1
rest_1))))
id_0))))))
(for-loop_1
null
flat-s_0)))))
(reverse$1
id_0))))))))
(let ((id:prefix82_1
id:prefix82_0))
(values
id:prefix82_1
id83_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((id:prefix80_0
id81_0)
(let ((prefix-all-defined-except79_1
prefix-all-defined-except79_0))
(values
prefix-all-defined-except79_1
id:prefix80_0
id81_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((prefix-all-defined-except76_0
id:prefix77_0
id78_0)
(values
#t
prefix-all-defined-except76_0
id:prefix77_0
id78_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
prefix-all-defined-except76_0
id:prefix77_0
id78_0)
(begin
(parse-all-from-module
self_0
spec_0
orig-s_0
id78_0
(syntax-e$1
id:prefix77_0)
at-phase_0
ns_0
rp_0
protected?_0)
(values
null
(list
spec_0))))
(args
(raise-binding-result-arity-error
4
args)))))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((expand88_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)
(call-with-values
(lambda ()
(let ((s_3
(car
s_2)))
(let ((s_4
(if (syntax?$1
s_3)
(syntax-e$1
s_3)
s_3)))
(if (pair?
s_4)
(let ((id93_0
(let ((s_5
(car
s_4)))
(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-spec_0
s_5)))))
(let ((datum94_0
(let ((s_5
(cdr
s_4)))
s_5)))
(let ((id93_1
id93_0))
(values
id93_1
datum94_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((id91_0
datum92_0)
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?$1
s_3)
(syntax-e$1
s_3)
s_3)))
(if (null?
s_4)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
(()
(let ((id91_1
id91_0)
(datum92_1
datum92_0))
(values
id91_1
datum92_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(args
(raise-binding-result-arity-error
2
args))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
((id89_0
datum90_0)
(let ((expand88_1
expand88_0))
(values
expand88_1
id89_0
datum90_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((expand85_0
id86_0
datum87_0)
(values
#t
expand85_0
id86_0
datum87_0))
(args
(raise-binding-result-arity-error
3
args)))))
(case-lambda
((ok?_0
expand85_0
id86_0
datum87_0)
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-spec_0)
(syntax-e$1
disarmed-spec_0)
disarmed-spec_0)))
(if (pair?
s_0)
(let ((expand97_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((form98_0
(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 ((form99_0
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?$1
s_3)
(syntax-e$1
s_3)
s_3)))
(if (null?
s_4)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0)))))
(case-lambda
(()
(let ((form99_1
form99_0))
(values
form99_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))))
(let ((expand97_1
expand97_0))
(values
expand97_1
form98_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-spec_0))))
(case-lambda
((expand95_0
form96_0)
(values
#t
expand95_0
form96_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_1
expand95_0
form96_0)
(let ((exp-spec_0
(let ((temp105_0
(if (expand-context/outer?
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
(free-id-set
at-phase_0
(list
(core-id
'begin
at-phase_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))))
(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?"
ctx_0))))
(expand.1
#f
#f
form96_0
temp105_0))))
(begin
(if (if (pair?
(syntax-e$1
exp-spec_0))
(if (identifier?
(car
(syntax-e$1
exp-spec_0)))
(eq?
'begin
(core-form-sym
exp-spec_0
at-phase_0))
#f)
#f)
(void)
(raise-syntax-error$1
'provide
"expansion was not a `begin' sequence"
orig-s_0
spec_0))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
exp-spec_0)
(syntax-e$1
exp-spec_0)
exp-spec_0)))
(if (pair?
s_0)
(let ((begin102_0
(let ((s_1
(car
s_0)))
s_1)))
(let ((spec103_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"
exp-spec_0)
flat-s_0))))))
(let ((begin102_1
begin102_0))
(values
begin102_1
spec103_0))))
(raise-syntax-error$1
#f
"bad syntax"
exp-spec_0))))
(case-lambda
((begin100_0
spec101_0)
(values
#t
begin100_0
spec101_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_2
begin100_0
spec101_0)
(call-with-values
(lambda ()
(loop_0
spec101_0
at-phase_0
protected?_0
layer_0))
(case-lambda
((track-stxes_1
exp-specs_1)
(values
(list*
spec_0
exp-spec_0
track-stxes_1)
exp-specs_1))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
3
args)))))))
(args
(raise-binding-result-arity-error
3
args)))))
(args
(raise-binding-result-arity-error
4
args))))))))))))))
(case-lambda
((track-stxes1_0 exp-specs2_0)
(values
(cons
track-stxes1_0
track-stxes_0)
(cons exp-specs2_0 exp-specs_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((track-stxes_1 exp-specs_1)
(values track-stxes_1 exp-specs_1))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((track-stxes_1 exp-specs_1)
(for-loop_0
track-stxes_1
exp-specs_1
rest_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values track-stxes_0 exp-specs_0)))))))
(for-loop_0 null null specs_1))))
(case-lambda
((track-stxes_0 exp-specs_0)
(let ((app_0 (reverse$1 track-stxes_0)))
(values app_0 (reverse$1 exp-specs_0))))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((track-stxess_0 exp-specss_0)
(let ((app_0 (apply append track-stxess_0)))
(values app_0 (apply append exp-specss_0))))
(args (raise-binding-result-arity-error 2 args)))))))))
(loop_0 specs_0 phase_0 #f 'raw)))))
(define parse-identifier!
(lambda (spec_0 orig-s_0 sym_0 at-phase_0 ns_0 rp_0 protected?_0)
(let ((b_0 (resolve+shift/extra-inspector spec_0 at-phase_0 ns_0)))
(begin
(if (module-binding? b_0)
(void)
(raise-syntax-error$1
'provide
"provided identifier is not defined or required"
orig-s_0
spec_0))
(let ((as-transformer?_0
(binding-for-transformer? b_0 spec_0 at-phase_0 ns_0)))
(let ((immed-b_0
(resolve+shift.1 #f #f null #t #f spec_0 at-phase_0)))
(add-provide!.1
protected?_0
as-transformer?_0
rp_0
sym_0
at-phase_0
b_0
immed-b_0
spec_0
orig-s_0)))))))
(define parse-struct!
(lambda (id:struct_0 orig-s_0 fields_0 at-phase_0 ns_0 rp_0 protected?_0)
(let ((mk_0
(|#%name|
mk
(lambda (fmt_0)
(begin
(let ((sym_0
(string->symbol
(format fmt_0 (syntax-e$1 id:struct_0)))))
(datum->syntax$1 id:struct_0 sym_0 id:struct_0)))))))
(let ((mk2_0
(|#%name|
mk2
(lambda (fmt_0 field-id_0)
(begin
(let ((sym_0
(string->symbol
(let ((app_0 (syntax-e$1 id:struct_0)))
(format fmt_0 app_0 (syntax-e$1 field-id_0))))))
(datum->syntax$1 id:struct_0 sym_0 id:struct_0)))))))
(begin
(let ((lst_0 (list "~a" "make-~a" "struct:~a" "~a?")))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((fmt_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(let ((id_0 (mk_0 fmt_0)))
(parse-identifier!
id_0
orig-s_0
(syntax-e$1 id_0)
at-phase_0
ns_0
rp_0
protected?_0))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((field_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(let ((get-id_0 (mk2_0 "~a-~a" field_0)))
(let ((set-id_0 (mk2_0 "set-~a-~a!" field_0)))
(begin
(parse-identifier!
get-id_0
orig-s_0
(syntax-e$1 get-id_0)
at-phase_0
ns_0
rp_0
protected?_0)
(parse-identifier!
set-id_0
orig-s_0
(syntax-e$1 set-id_0)
at-phase_0
ns_0
rp_0
protected?_0))))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 fields_0)))
(void))))))
(define parse-all-from
(lambda (mod-path-stx_0
orig-s_0
self_0
except-ids_0
at-phase_0
ns_0
rp_0
protected?_0
ctx_0)
(let ((mod-path_0 (syntax->datum$1 mod-path-stx_0)))
(begin
(if (1/module-path? mod-path_0)
(void)
(raise-syntax-error$1
'provide
"not a module path"
orig-s_0
mod-path-stx_0))
(let ((mpi_0 (module-path->mpi/context mod-path_0 ctx_0)))
(parse-all-from-module
mpi_0
#f
orig-s_0
except-ids_0
#f
at-phase_0
ns_0
rp_0
protected?_0))))))
(define parse-all-from-module
(lambda (mpi_0
matching-stx_0
orig-s_0
except-ids_0
prefix-sym_0
at-phase_0
ns_0
rp_0
protected?_0)
(let ((requireds_0 (extract-module-requires rp_0 mpi_0 at-phase_0)))
(let ((phase-desc_0
(|#%name|
phase-desc
(lambda ()
(begin
(if (begin-unsafe (eq? at-phase_0 0))
""
(if (begin-unsafe (not at-phase_0))
" for-label"
(format " for phase ~a" at-phase_0))))))))
(begin
(if requireds_0
(void)
(raise-syntax-error$1
'provide
(format
"cannot provide from a module without a matching require~a"
(phase-desc_0))
orig-s_0
matching-stx_0))
(let ((add-prefix_0
(|#%name|
add-prefix
(lambda (sym_0)
(begin
(if prefix-sym_0
(string->symbol
(let ((app_0 (symbol->string prefix-sym_0)))
(string-append app_0 (symbol->string sym_0))))
sym_0))))))
(let ((found_0 (make-hasheq)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((i_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(let ((id_0 (required-id i_0)))
(let ((phase_0 (required-phase i_0)))
(if (let ((or-part_0
(if matching-stx_0
(not
(if (eqv?
phase_0
at-phase_0)
(free-identifier=?$1
id_0
(datum->syntax$1
matching-stx_0
(syntax-e$1 id_0))
phase_0
phase_0)
#f))
#f)))
(if or-part_0
or-part_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((except-id_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((result_1
(let ((result_1
(if (free-identifier=?$1
id_0
except-id_0
phase_0
phase_0)
(hash-set!
found_0
except-id_0
#t)
#f)))
(values
result_1))))
(if (if (not
(let ((x_0
(list
except-id_0)))
result_1))
#t
#f)
(for-loop_1
result_1
rest_1)
result_1))))
result_0))))))
(for-loop_1
#f
except-ids_0)))))
(void)
(let ((b_0
(resolve+shift/extra-inspector
id_0
phase_0
ns_0)))
(let ((immed-b_0
(resolve+shift.1
#f
#f
null
#t
#f
id_0
phase_0)))
(let ((temp122_0
(add-prefix_0
(syntax-e$1 id_0))))
(let ((temp129_0
(required-as-transformer?
i_0)))
(let ((temp122_1 temp122_0))
(add-provide!.1
protected?_0
temp129_0
rp_0
temp122_1
phase_0
b_0
immed-b_0
id_0
orig-s_0)))))))))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 requireds_0)))
(void)
(if (let ((app_0 (hash-count found_0)))
(= app_0 (length except-ids_0)))
(void)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((except-id_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(if (let ((or-part_0
(hash-ref
found_0
except-id_0
#f)))
(if or-part_0
or-part_0
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (result_0 lst_1)
(begin
(if (pair? lst_1)
(let ((i_0
(unsafe-car
lst_1)))
(let ((rest_1
(unsafe-cdr
lst_1)))
(let ((id_0
(required-id
i_0)))
(let ((result_1
(let ((result_1
(let ((phase_0
(required-phase
i_0)))
(free-identifier=?$1
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)))))
result_0))))))
(for-loop_1
#f
requireds_0)))))
(void)
(raise-syntax-error$1
'provide
(let ((app_0
(if matching-stx_0
"excluded identifier was not defined or required in the module~a"
"excluded identifier was not required from the specified module~a")))
(format app_0 (phase-desc_0)))
orig-s_0
except-id_0))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 except-ids_0)))
(void)))))))))))
(define check-cross-phase-persistent-form
(lambda (bodys_0 self-mpi_0)
(letrec*
((check-body_0
(|#%name|
check-body
(lambda (bodys_1)
(begin
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((body_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(let ((p_0
(if (expanded+parsed? body_0)
(expanded+parsed-parsed body_0)
body_0)))
(if (parsed-define-values? p_0)
(check-expr_0
(parsed-define-values-rhs p_0)
(length (parsed-define-values-syms p_0))
p_0)
(if (let ((or-part_0
(|parsed-#%declare?| p_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(parsed-module? p_0)))
(if or-part_1
or-part_1
(syntax?$1 p_0)))))
(void)
(disallow p_0))))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 bodys_1)))
(void))))))
(check-expr_0
(|#%name|
check-expr
(lambda (e_0 num-results_0 enclosing_0)
(begin
(if (parsed-lambda? e_0)
(begin
(check-count 1 num-results_0 enclosing_0)
(check-no-disallowed-expr_0 e_0))
(if (parsed-case-lambda? e_0)
(begin
(check-count 1 num-results_0 enclosing_0)
(check-no-disallowed-expr_0 e_0))
(if (parsed-quote? e_0)
(begin
(check-datum (parsed-quote-datum e_0) e_0)
(check-count 1 num-results_0 enclosing_0))
(if (parsed-app? e_0)
(let ((rands_0 (parsed-app-rands e_0)))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((rand_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(check-expr_0 rand_0 1 e_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 rands_0)))
(void)
(let ((tmp_0
(cross-phase-primitive-name
(parsed-app-rator e_0))))
(if (if (eq? tmp_0 'cons) #t (eq? tmp_0 'list))
(check-count 1 num-results_0 enclosing_0)
(if (eq? tmp_0 'make-struct-type)
(check-count 5 num-results_0 enclosing_0)
(if (eq? tmp_0 'make-struct-type-property)
(check-count 3 num-results_0 enclosing_0)
(if (eq? tmp_0 'gensym)
(if (let ((or-part_0 (= 0 (length rands_0))))
(if or-part_0
or-part_0
(if (= 1 (length rands_0))
(quoted-string? (car rands_0))
#f)))
(void)
(disallow e_0))
(if (eq? tmp_0 'string->uninterned-symbol)
(if (if (= 1 (length rands_0))
(quoted-string? (car rands_0))
#f)
(void)
(disallow e_0))
(disallow e_0)))))))))
(check-no-disallowed-expr_0 e_0)))))))))
(check-no-disallowed-expr_0
(|#%name|
check-no-disallowed-expr
(lambda (e_0)
(begin
(if (parsed-lambda? e_0)
(check-body-no-disallowed-expr_0 (parsed-lambda-body e_0))
(if (parsed-case-lambda? e_0)
(begin
(let ((lst_0 (parsed-case-lambda-clauses e_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((clause_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(check-body-no-disallowed-expr_0
(cadr clause_0))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void))
(if (if (parsed-app? e_0)
(if (eq?
'variable-reference-from-unsafe?
(cross-phase-primitive-name (parsed-app-rator e_0)))
(andmap_2344
|parsed-#%variable-reference?|
(parsed-app-rands e_0))
#f)
#f)
(void)
(if (parsed-app? e_0)
(begin
(check-no-disallowed-expr_0 (parsed-app-rator e_0))
(let ((lst_0 (parsed-app-rands e_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((e_1 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(check-no-disallowed-expr_0 e_1)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void))
(if (parsed-if? e_0)
(begin
(check-no-disallowed-expr_0 (parsed-if-tst e_0))
(check-no-disallowed-expr_0 (parsed-if-thn e_0))
(check-no-disallowed-expr_0 (parsed-if-els e_0)))
(if (parsed-set!? e_0)
(let ((id_0 (parsed-set!-id e_0)))
(let ((normal-b_0 (parsed-id-binding id_0)))
(begin
(if (let ((or-part_0 (not normal-b_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (parsed-top-id? id_0)))
(if or-part_1
or-part_1
(if (not (symbol? normal-b_0))
(eq?
(module-binding-module normal-b_0)
self-mpi_0)
#f)))))
(disallow e_0)
(void))
(check-no-disallowed-expr_0
(parsed-set!-rhs e_0)))))
(if (parsed-with-continuation-mark? e_0)
(begin
(check-no-disallowed-expr_0
(parsed-with-continuation-mark-key e_0))
(check-no-disallowed-expr_0
(parsed-with-continuation-mark-val e_0))
(check-no-disallowed-expr_0
(parsed-with-continuation-mark-body e_0)))
(if (parsed-begin? e_0)
(check-body-no-disallowed-expr_0
(parsed-begin-body e_0))
(if (parsed-begin0? e_0)
(check-body-no-disallowed-expr_0
(parsed-begin0-body e_0))
(if (parsed-let_-values? e_0)
(begin
(let ((lst_0
(parsed-let_-values-clauses e_0)))
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((clause_0
(unsafe-car lst_1)))
(let ((rest_0
(unsafe-cdr lst_1)))
(begin
(check-no-disallowed-expr_0
(cadr clause_0))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 lst_0))))
(void)
(check-body-no-disallowed-expr_0
(parsed-let_-values-body e_0)))
(if (let ((or-part_0
(parsed-quote-syntax? e_0)))
(if or-part_0
or-part_0
(|parsed-#%variable-reference?| e_0)))
(disallow e_0)
(void))))))))))))))))
(check-body-no-disallowed-expr_0
(|#%name|
check-body-no-disallowed-expr
(lambda (l_0)
(begin
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((e_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(check-no-disallowed-expr_0 e_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 l_0)))
(void)))))))
(check-body_0 bodys_0))))
(define check-count
(lambda (is-num_0 expected-num_0 enclosing_0)
(if (= is-num_0 expected-num_0) (void) (disallow enclosing_0))))
(define check-datum
(lambda (d_0 e_0)
(if (let ((or-part_0 (number? d_0)))
(if or-part_0
or-part_0
(let ((or-part_1 (boolean? d_0)))
(if or-part_1
or-part_1
(let ((or-part_2 (symbol? d_0)))
(if or-part_2
or-part_2
(let ((or-part_3 (string? d_0)))
(if or-part_3
or-part_3
(let ((or-part_4 (bytes? d_0)))
(if or-part_4 or-part_4 (null? d_0)))))))))))
(void)
(disallow e_0))))
(define quoted-string?
(lambda (e_0)
(if (parsed-quote? e_0) (string? (parsed-quote-datum e_0)) #f)))
(define cross-phase-primitive-name
(lambda (id_0)
(if (parsed-id? id_0)
(let ((b_0 (parsed-id-binding id_0)))
(if (module-binding? b_0)
(if (eq?
runtime-module-name
(1/module-path-index-resolve (module-binding-module b_0)))
(module-binding-sym b_0)
#f)
#f))
#f)))
(define disallow
(lambda (body_0)
(raise-syntax-error$1
'module
"not allowed in a cross-phase persistent module"
(if (parsed? body_0)
(datum->syntax$1 #f body_0 (parsed-s body_0))
body_0))))
(define effect_2989
(begin
(void
(add-core-form!*
'module
(lambda (s_0 ctx_0)
(begin
(if (eq?
(begin-unsafe (expand-context/outer-context ctx_0))
'top-level)
(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 'prim-module #f) (void)))
(raise-syntax-error$1 #f "allowed only at the top level" s_0)))
(if log-performance?
(start-performance-region 'expand 'module)
(void))
(begin0
(|#%app|
expand-module.1
#f
#f
#f
#f
unsafe-undefined
#f
s_0
ctx_0
#f)
(if log-performance? (end-performance-region) (void)))))))
(void)))
(define effect_2067
(begin
(void
(add-core-form!*
'module*
(lambda (s_0 ctx_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 'prim-module #f) (void)))
(raise-syntax-error$1
#f
"illegal use (not in a module top-level)"
s_0)))))
(void)))
(define effect_2370
(begin
(void
(add-core-form!*
'|#%module-begin|
(lambda (s_0 ctx_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 'prim-module-begin #f)
(void)))
(if (eq?
(begin-unsafe (expand-context/outer-context ctx_0))
'module-begin)
(void)
(raise-syntax-error$1 #f "not in a module-definition context" s_0))
(if (begin-unsafe
(expand-context/inner-module-begin-k
(root-expand-context/outer-inner ctx_0)))
(void)
(raise-syntax-error$1
#f
"not currently transforming a module"
s_0))
(|#%app|
(begin-unsafe
(expand-context/inner-module-begin-k
(root-expand-context/outer-inner ctx_0)))
s_0
(if (expand-context/outer? ctx_0)
(let ((the-struct_0 (root-expand-context/outer-inner ctx_0)))
(let ((inner198_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)
#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))))
(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?"
ctx_0)))))))
(void)))
(define effect_2522
(begin
(void
(add-core-form!*
'|#%declare|
(lambda (s_0 ctx_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 'prim-declare #f) (void)))
(raise-syntax-error$1
#f
"not allowed outside of a module body"
s_0)))))
(void)))
(define expand-module.1
(|#%name|
expand-module
(lambda (always-produce-compiled?1_0
enclosing-is-cross-phase-persistent?3_0
enclosing-requires+provides4_0
keep-enclosing-scope-at-phase2_0
modules-being-compiled6_0
mpis-for-enclosing-reset5_0
s13_0
init-ctx14_0
enclosing-self15_0)
(begin
(let ((modules-being-compiled_0
(if (eq? modules-being-compiled6_0 unsafe-undefined)
(make-hasheq)
modules-being-compiled6_0)))
(let ((disarmed-s_0 (syntax-disarm$1 s13_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 'prim-module disarmed-s_0)
(void)))
(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 ((module204_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 ((id:module-name208_0
(let ((s_3 (car s_2)))
(if (let ((or-part_0
(if (syntax?$1 s_3)
(symbol?
(syntax-e$1 s_3))
#f)))
(if or-part_0
or-part_0
(symbol? s_3)))
s_3
(raise-syntax-error$1
#f
"not an identifier"
disarmed-s_0
s_3)))))
(call-with-values
(lambda ()
(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 ((initial-require211_0
(let ((s_5 (car s_4)))
s_5)))
(let ((body212_0
(let ((s_5 (cdr s_4)))
(let ((s_6
(if (syntax?$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"
disarmed-s_0)
flat-s_0))))))
(let ((initial-require211_1
initial-require211_0))
(values
initial-require211_1
body212_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((initial-require209_0 body210_0)
(let ((id:module-name208_1
id:module-name208_0))
(values
id:module-name208_1
initial-require209_0
body210_0)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((id:module-name205_0
initial-require206_0
body207_0)
(let ((module204_1 module204_0))
(values
module204_1
id:module-name205_0
initial-require206_0
body207_0)))
(args (raise-binding-result-arity-error 3 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((module200_0
id:module-name201_0
initial-require202_0
body203_0)
(values
#t
module200_0
id:module-name201_0
initial-require202_0
body203_0))
(args (raise-binding-result-arity-error 4 args)))))
(case-lambda
((ok?_0
module200_0
id:module-name201_0
initial-require202_0
body203_0)
(let ((rebuild-s_0
(keep-as-needed.1 #f #t #t init-ctx14_0 s13_0)))
(let ((initial-require_0
(syntax->datum$1 initial-require202_0)))
(begin
(if (if keep-enclosing-scope-at-phase2_0
keep-enclosing-scope-at-phase2_0
(1/module-path? initial-require_0))
(void)
(raise-syntax-error$1
#f
"not a module path"
s13_0
initial-require202_0))
(let ((module-name-sym_0
(syntax-e$1 id:module-name201_0)))
(let ((outside-scope_0 (new-scope 'module)))
(let ((inside-scope_0
(new-multi-scope module-name-sym_0)))
(let ((self_0
(make-self-module-path-index
(if enclosing-self15_0
module-name-sym_0
(string->uninterned-symbol
(symbol->string module-name-sym_0)))
enclosing-self15_0)))
(let ((enclosing-mod_0
(if enclosing-self15_0
(1/module-path-index-join
'(submod "..")
self_0)
#f)))
(begin
(if mpis-for-enclosing-reset5_0
(set-box!
mpis-for-enclosing-reset5_0
(cons
enclosing-mod_0
(unbox mpis-for-enclosing-reset5_0)))
(void))
(let ((apply-module-scopes_0
(make-apply-module-scopes
outside-scope_0
inside-scope_0
init-ctx14_0
keep-enclosing-scope-at-phase2_0
self_0
enclosing-self15_0
enclosing-mod_0)))
(let ((initial-require-s_0
(|#%app|
apply-module-scopes_0
initial-require202_0)))
(let ((root-ctx_0
(let ((temp226_0
(if keep-enclosing-scope-at-phase2_0
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner
init-ctx14_0)))
null)))
(make-root-expand-context.1
initial-require-s_0
temp226_0
outside-scope_0
inside-scope_0
self_0))))
(let ((new-module-scopes_0
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner
root-ctx_0)))))
(let ((frame-id_0
(begin-unsafe
(root-expand-context/outer-frame-id
root-ctx_0))))
(let ((make-m-ns_0
(|#%name|
make-m-ns
(lambda (for-submodule?213_0
ns215_0)
(begin
(let ((for-submodule?_0
(if (eq?
for-submodule?213_0
unsafe-undefined)
(if enclosing-self15_0
#t
#f)
for-submodule?213_0)))
(make-module-namespace.1
for-submodule?_0
self_0
root-ctx_0
ns215_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)
(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)
scoped-s_0)))
(if (pair?
s_0)
(let ((_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 ((_1
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(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 ((_2
(let ((s_5
(car
s_4)))
s_5)))
(let ((body253_0
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?$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
_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
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
(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))))))))))))))))))
(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
(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))
(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
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
(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
(check-defined-by-now
need-eventually-defined_0
self_0
ctx_1
requires+provides_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
'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 ((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|
ensure-module-begin
(lambda (ctx20_0
def-ctx-scopes21_0
m-ns19_0
module-name-sym17_0
phase22_0
s23_0
scopes-s18_0
bodys31_0)
(begin
(let ((make-mb-ctx_0
(|#%name|
make-mb-ctx
(lambda ()
(begin
(if (expand-context/outer? ctx20_0)
(let ((inner408_0
(root-expand-context/outer-inner 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?"
ctx20_0)))))))
(let ((mb_0
(if (= 1 (length bodys31_0))
(if (eq?
'|#%module-begin|
(core-form-sym
(syntax-disarm$1 (car bodys31_0))
phase22_0))
(car bodys31_0)
(let ((named-body-s_0
(let ((stx_0 (car bodys31_0)))
(begin-unsafe
(syntax-property$1
stx_0
'enclosing-module-name
module-name-sym17_0)))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx20_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'property
named-body-s_0
(car bodys31_0))
(void)))
(let ((partly-expanded-body_0
(begin
(if log-performance?
(start-performance-region
'expand
'module-begin)
(void))
(begin0
(let ((temp410_0 (make-mb-ctx_0)))
(expand.1 #f #f named-body-s_0 temp410_0))
(if log-performance?
(end-performance-region)
(void))))))
(if (eq?
'|#%module-begin|
(core-form-sym
(syntax-disarm$1 partly-expanded-body_0)
phase22_0))
partly-expanded-body_0
(let ((temp411_0 (list partly-expanded-body_0)))
(let ((temp416_0 (make-mb-ctx_0)))
(let ((temp411_1 temp411_0))
(add-module-begin.1
#f
temp411_1
s23_0
scopes-s18_0
phase22_0
module-name-sym17_0
temp416_0)))))))))
(let ((temp423_0 (make-mb-ctx_0)))
(add-module-begin.1
#t
bodys31_0
s23_0
scopes-s18_0
phase22_0
module-name-sym17_0
temp423_0)))))
(let ((named-mb_0
(begin-unsafe
(syntax-property$1
mb_0
'enclosing-module-name
module-name-sym17_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx20_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'property
named-mb_0
mb_0)
(void)))
named-mb_0))))))))
(define add-module-begin.1
(|#%name|
add-module-begin
(lambda (log-rename-one?33_0
bodys35_0
s36_0
scopes-s37_0
phase38_0
module-name-sym39_0
mb-ctx40_0)
(begin
(let ((disarmed-scopes-s_0 (syntax-disarm$1 scopes-s37_0)))
(let ((mb-id_0
(datum->syntax$1 disarmed-scopes-s_0 '|#%module-begin|)))
(begin
(if (resolve.1 #f #f null #f mb-id_0 phase38_0)
(void)
(raise-syntax-error$1
#f
"no #%module-begin binding in the module's language"
s36_0))
(let ((mb_0
(datum->syntax$1
disarmed-scopes-s_0
(list* mb-id_0 bodys35_0)
s36_0
s36_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner mb-ctx40_0)))))
(if obs_0 (call-expand-observe obs_0 'tag mb_0) (void)))
(let ((named-mb_0
(begin-unsafe
(syntax-property$1
mb_0
'enclosing-module-name
module-name-sym39_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner mb-ctx40_0)))))
(if obs_0
(call-expand-observe
obs_0
'track-syntax
'property
named-mb_0
mb_0)
(void)))
(let ((partly-expanded-mb_0
(begin
(if log-performance?
(start-performance-region
'expand
'module-begin)
(void))
(begin0
(expand.1 #f #f named-mb_0 mb-ctx40_0)
(if log-performance?
(end-performance-region)
(void))))))
(begin
(if (eq?
'|#%module-begin|
(core-form-sym
(syntax-disarm$1 partly-expanded-mb_0)
phase38_0))
(void)
(raise-syntax-error$1
#f
"expansion of #%module-begin is not a #%plain-module-begin form"
s36_0
partly-expanded-mb_0))
partly-expanded-mb_0)))))))))))))
(define add-enclosing-name-property
(lambda (stx_0 module-name-sym_0)
(syntax-property$1 stx_0 'enclosing-module-name module-name-sym_0)))
(define make-apply-module-scopes
(lambda (inside-scope_0
outside-scope_0
init-ctx_0
keep-enclosing-scope-at-phase_0
self_0
enclosing-self_0
enclosing-mod_0)
(lambda (s_0)
(begin
(if log-performance?
(start-performance-region 'expand 'module 'scopes)
(void))
(begin0
(let ((s-without-enclosing_0
(if keep-enclosing-scope-at-phase_0
s_0
(remove-use-site-scopes
(remove-scopes
s_0
(begin-unsafe
(root-expand-context/inner-module-scopes
(root-expand-context/outer-inner init-ctx_0))))
init-ctx_0))))
(let ((s-with-edges_0
(add-scope
(add-scope s-without-enclosing_0 outside-scope_0)
inside-scope_0)))
(let ((s-with-suitable-enclosing_0
(if keep-enclosing-scope-at-phase_0
(syntax-module-path-index-shift.1
#f
s-with-edges_0
enclosing-self_0
enclosing-mod_0
#f)
s-with-edges_0)))
(let ((temp429_0 (make-generic-self-module-path-index self_0)))
(let ((temp431_0 (current-code-inspector)))
(let ((temp429_1 temp429_0))
(syntax-module-path-index-shift.1
#f
s-with-suitable-enclosing_0
temp429_1
self_0
temp431_0)))))))
(if log-performance? (end-performance-region) (void)))))))
(define partially-expand-bodys.1
(|#%name|
partially-expand-bodys
(lambda (all-scopes-stx49_0
compiled-submodules53_0
ctx43_0
declared-keywords51_0
declared-submodule-names52_0
defined-syms50_0
frame-id46_0
loop56_0
modules-being-compiled54_0
mpis-to-reset55_0
namespace44_0
need-eventually-defined48_0
phase42_0
requires-and-provides47_0
self45_0
bodys72_0)
(begin
(begin
(namespace-visit-available-modules! namespace44_0 phase42_0)
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 bodys_0)
(begin
(if (null? bodys_0)
(if (if tail?_0 (not (zero? phase42_0)) #f)
null
(if tail?_0
(let ((bodys_1
(let ((app_0
(let ((to-module-lifts_0
(begin-unsafe
(expand-context/inner-to-module-lifts
(root-expand-context/outer-inner
ctx43_0)))))
(begin-unsafe
(box-clear!
(to-module-lift-context-ends
to-module-lifts_0))))))
(append
app_0
(let ((to-module-lifts_0
(begin-unsafe
(expand-context/inner-to-module-lifts
(root-expand-context/outer-inner
ctx43_0)))))
(begin-unsafe
(box-clear!
(to-module-lift-context-provides
to-module-lifts_0))))))))
(if (null? bodys_1)
null
(let ((added-bodys_0
(add-post-expansion-scope bodys_1 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
'module-end-lifts
added-bodys_0)
(void)))
(loop_0 #t added-bodys_0)))))
null))
(let ((rest-bodys_0 (cdr 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 'next) (void)))
(let ((exp-body_0
(begin
(if log-performance?
(start-performance-region
'expand
'form-in-module/1)
(void))
(begin0
(let ((temp435_0 (car bodys_0)))
(expand.1 #f #f temp435_0 ctx43_0))
(if log-performance?
(end-performance-region)
(void))))))
(let ((disarmed-exp-body_0
(syntax-disarm$1 exp-body_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 ((require-lifts_0
(begin-unsafe
(expand-context/inner-require-lifts
(root-expand-context/outer-inner
ctx43_0)))))
(let ((lifted-reqs_0
(begin-unsafe
(box-clear!
(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 ((tmp_0
(core-form-sym
disarmed-exp-body_0
phase42_0)))
(if (eq?
tmp_0
'begin)
(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)))
(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
'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)))
(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
'define-syntaxes)
(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-syntaxes
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-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
'|#%require|)
(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-require
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|
(let ((s_1
(car
s_0)))
s_1)))
(let ((req518_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"
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))))))
(if (eq?
tmp_0
'|#%provide|)
(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
'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
frame-id_0
inside-scope_0
all-scopes-stx_0
defined-syms_0
requires+provides_0)
(lambda (ids_0 rhs_0 phase_0)
(let ((scoped-ids_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope id_0 inside-scope_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 ((syms_0
(select-defined-syms-and-bind!.1
#f
frame-id_0
#f
requires+provides_0
#f
scoped-ids_0
defined-syms_0
self_0
phase_0
all-scopes-stx_0)))
(let ((s_0
(add-scope
(datum->syntax$1
#f
(list
(datum->syntax$1
(syntax-shift-phase-level$1 core-stx phase_0)
'define-values)
scoped-ids_0
rhs_0))
inside-scope_0)))
(values
scoped-ids_0
(semi-parsed-define-values2.1
s_0
syms_0
scoped-ids_0
rhs_0))))))))
(define add-post-expansion-scope
(lambda (bodys_0 ctx_0)
(let ((pe_0
(begin-unsafe (root-expand-context/outer-post-expansion ctx_0))))
(if pe_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((body_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(apply-post-expansion pe_0 body_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null bodys_0))))
bodys_0))))
(define finish-expanding-body-expressions.1
(|#%name|
finish-expanding-body-expressions
(lambda (compiled-submodules78_0
ctx75_0
declared-submodule-names77_0
modules-being-compiled79_0
mpis-to-reset80_0
phase74_0
self76_0
partially-expanded-bodys88_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (tail?_0 bodys_0)
(begin
(if (null? bodys_0)
(if (if tail?_0 (not (zero? phase74_0)) #f)
null
(if tail?_0
(let ((bodys_1
(let ((app_0
(let ((to-module-lifts_0
(begin-unsafe
(expand-context/inner-to-module-lifts
(root-expand-context/outer-inner
ctx75_0)))))
(begin-unsafe
(box-clear!
(to-module-lift-context-ends
to-module-lifts_0))))))
(append
app_0
(let ((to-module-lifts_0
(begin-unsafe
(expand-context/inner-to-module-lifts
(root-expand-context/outer-inner
ctx75_0)))))
(begin-unsafe
(box-clear!
(to-module-lift-context-provides
to-module-lifts_0))))))))
(if (null? bodys_1)
null
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx75_0)))))
(if obs_0
(call-expand-observe
obs_0
'module-end-lifts
bodys_1)
(void)))
(loop_0
#t
(add-post-expansion-scope bodys_1 ctx75_0)))))
null))
(begin
(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) (void)))
(let ((body_0 (car bodys_0)))
(let ((rest-bodys_0 (cdr bodys_0)))
(let ((exp-body_0
(if (let ((or-part_0 (parsed? body_0)))
(if or-part_0
or-part_0
(let ((or-part_1
(expanded+parsed? body_0)))
(if or-part_1
or-part_1
(semi-parsed-begin-for-syntax?
body_0)))))
body_0
(if (semi-parsed-define-values? body_0)
(let ((ids_0
(semi-parsed-define-values-ids
body_0)))
(let ((rhs-ctx_0
(as-named-context
(as-expression-context ctx75_0)
ids_0)))
(let ((syms_0
(semi-parsed-define-values-syms
body_0)))
(let ((s_0
(semi-parsed-define-values-s
body_0)))
(call-with-values
(lambda ()
(let ((s_1 (syntax-disarm$1 s_0)))
(if (if (not
(begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
rhs-ctx_0))))
#t
#f)
(call-with-values
(lambda ()
(let ((s_2
(if (syntax?$1 s_1)
(syntax-e$1 s_1)
s_1)))
(if (pair? s_2)
(let ((define-values550_0
(let ((s_3
(car
s_2)))
s_3)))
(call-with-values
(lambda ()
(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 ((_0
(let ((s_5
(car
s_4)))
s_5)))
(let ((_1
(let ((s_5
(cdr
s_4)))
(let ((s_6
(if (syntax?$1
s_5)
(syntax-e$1
s_5)
s_5)))
(if (pair?
s_6)
(let ((_1
(let ((s_7
(car
s_6)))
s_7)))
(call-with-values
(lambda ()
(let ((s_7
(cdr
s_6)))
(let ((s_8
(if (syntax?$1
s_7)
(syntax-e$1
s_7)
s_7)))
(if (null?
s_8)
(values)
(raise-syntax-error$1
#f
"bad syntax"
s_1)))))
(case-lambda
(()
(let ((_2
_1))
(values
_2)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
s_1))))))
(let ((_2
_0))
(values
_2
_1))))
(raise-syntax-error$1
#f
"bad syntax"
s_1)))))
(case-lambda
((_0 _1)
(let ((define-values550_1
define-values550_0))
(values
define-values550_1
_0
_1)))
(args
(raise-binding-result-arity-error
2
args)))))
(raise-syntax-error$1
#f
"bad syntax"
s_1))))
(case-lambda
((define-values547_0 _0 _1)
(values
#t
define-values547_0
_0
_1))
(args
(raise-binding-result-arity-error
3
args))))
(values #f #f #f #f))))
(case-lambda
((ok?_0 define-values547_0 _0 _1)
(let ((rebuild-s_0
(keep-as-needed.1
#f
#f
#t
rhs-ctx_0
s_0)))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx75_0)))))
(if obs_0
(begin
(call-expand-observe
obs_0
'visit
#f)
(call-expand-observe
obs_0
'enter-prim
#f)
(call-expand-observe
obs_0
'prim-define-values
#f))
(void)))
(let ((exp-rhs_0
(begin
(if log-performance?
(start-performance-region
'expand
'form-in-module/2)
(void))
(begin0
(let ((temp559_0
(semi-parsed-define-values-rhs
body_0)))
(expand.1
#f
#f
temp559_0
rhs-ctx_0))
(if log-performance?
(end-performance-region)
(void))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx75_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-prim/return
#f)
(void)))
(let ((comp-form_0
(parsed-define-values19.1
rebuild-s_0
ids_0
syms_0
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
rhs-ctx_0)))
exp-rhs_0
(let ((temp562_0
(as-to-parsed-context
rhs-ctx_0)))
(expand.1
#f
#f
exp-rhs_0
temp562_0))))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
rhs-ctx_0)))
comp-form_0
(expanded+parsed1.1
(let ((temp564_0
(list
define-values547_0
ids_0
exp-rhs_0)))
(rebuild.1
#t
rebuild-s_0
temp564_0))
comp-form_0))))))))
(args
(raise-binding-result-arity-error
4
args))))))))
(let ((disarmed-body_0
(syntax-disarm$1 body_0)))
(let ((tmp_0
(core-form-sym
disarmed-body_0
phase74_0)))
(if (if (eq? tmp_0 '|#%require|)
#t
(if (eq? tmp_0 '|#%provide|)
#t
(eq? tmp_0 'module*)))
body_0
(begin
(if log-performance?
(start-performance-region
'expand
'form-in-module/2)
(void))
(begin0
(let ((exp-body_0
(let ((temp566_0
(as-expression-context
ctx75_0)))
(expand.1
#f
#f
body_0
temp566_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx75_0)))
exp-body_0
(expanded+parsed1.1
exp-body_0
(let ((temp568_0
(as-to-parsed-context
ctx75_0)))
(expand.1
#f
#f
exp-body_0
temp568_0)))))
(if log-performance?
(end-performance-region)
(void)))))))))))
(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 ((require-lifts_0
(begin-unsafe
(expand-context/inner-require-lifts
(root-expand-context/outer-inner
ctx75_0)))))
(let ((lifted-requires_0
(begin-unsafe
(box-clear!
(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
'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)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (i_0)
(begin
(if i_0
(call-with-values
(lambda ()
(hash-iterate-key+value need-eventually-defined_0 i_0))
(case-lambda
((phase_0 l_0)
(begin
(begin
(let ((lst_0 (reverse$1 l_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (lst_1)
(begin
(if (pair? lst_1)
(let ((id_0 (unsafe-car lst_1)))
(let ((rest_0 (unsafe-cdr lst_1)))
(begin
(let ((b_0
(resolve+shift.1
#f
#f
null
unsafe-undefined
#f
id_0
phase_0)))
(let ((bound-here?_0
(if b_0
(if (module-binding?
b_0)
(if (let ((app_0
(module-binding-sym
b_0)))
(eq?
app_0
(syntax-e$1
id_0)))
(eq?
(module-binding-module
b_0)
self_0)
#f)
#f)
#f)))
(let ((bound-kind_0
(if bound-here?_0
(defined-sym-kind
requires+provides_0
(module-binding-sym
b_0)
phase_0)
#f)))
(if (eq?
bound-kind_0
'variable)
(void)
(let ((app_0
(let ((app_0
(if (not
b_0)
"reference to an unbound identifier"
(if (eq?
bound-kind_0
'transformer)
"identifier treated as a variable, but later defined as syntax"
"identifier treated as a variable, but later bound differently"))))
(string-append
app_0
(format
"\n at phase: ~a"
(if (eq?
phase_0
1)
"1; the transformer environment"
phase_0))))))
(raise-syntax-error$1
#f
app_0
id_0
#f
null
(syntax-debug-info-string
id_0
ctx_0)))))))
(for-loop_1 rest_0))))
(values)))))))
(for-loop_1 lst_0))))
(void))
(for-loop_0
(hash-iterate-next need-eventually-defined_0 i_0))))
(args (raise-binding-result-arity-error 2 args))))
(values)))))))
(for-loop_0 (hash-iterate-first need-eventually-defined_0))))
(void))))
(define resolve-provides.1
(|#%name|
resolve-provides
(lambda (ctx95_0
declared-submodule-names91_0
namespace92_0
phase93_0
requires-and-provides90_0
self94_0
expression-expanded-bodys102_0)
(begin
(begin
(if log-performance?
(start-performance-region 'expand 'provide)
(void))
(begin0
(letrec*
((loop_0
(|#%name|
loop
(lambda (bodys_0 phase_0)
(begin
(if (null? bodys_0)
null
(if (let ((or-part_0 (parsed? (car bodys_0))))
(if or-part_0
or-part_0
(expanded+parsed? (car bodys_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx95_0)))))
(if obs_0 (call-expand-observe obs_0 'next) (void)))
(let ((app_0 (car bodys_0)))
(cons app_0 (loop_0 (cdr bodys_0) phase_0))))
(if (semi-parsed-begin-for-syntax? (car bodys_0))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx95_0)))))
(if obs_0
(call-expand-observe
obs_0
'enter-begin-for-syntax)
(void)))
(let ((nested-bodys_0
(let ((app_0
(semi-parsed-begin-for-syntax-body
(car bodys_0))))
(loop_0 app_0 (add1 phase_0)))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx95_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-begin-for-syntax)
(void)))
(let ((app_0
(let ((the-struct_0 (car bodys_0)))
(if (semi-parsed-begin-for-syntax?
the-struct_0)
(semi-parsed-begin-for-syntax3.1
(semi-parsed-begin-for-syntax-s
the-struct_0)
nested-bodys_0)
(raise-argument-error
'struct-copy
"semi-parsed-begin-for-syntax?"
the-struct_0)))))
(cons
app_0
(loop_0 (cdr bodys_0) phase_0))))))
(let ((disarmed-body_0
(syntax-disarm$1 (car bodys_0))))
(let ((tmp_0
(core-form-sym disarmed-body_0 phase_0)))
(if (eq? tmp_0 '|#%provide|)
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx95_0)))))
(if obs_0
(begin
(call-expand-observe
obs_0
'enter-prim
(car bodys_0))
(call-expand-observe
obs_0
'prim-provide
disarmed-body_0))
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1 disarmed-body_0)
(syntax-e$1 disarmed-body_0)
disarmed-body_0)))
(if (pair? s_0)
(let ((|#%provide582_0|
(let ((s_1 (car s_0))) s_1)))
(let ((spec583_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-body_0)
flat-s_0))))))
(let ((|#%provide582_1|
|#%provide582_0|))
(values
|#%provide582_1|
spec583_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-body_0))))
(case-lambda
((|#%provide580_0| spec581_0)
(values #t |#%provide580_0| spec581_0))
(args
(raise-binding-result-arity-error
2
args)))))
(case-lambda
((ok?_0 |#%provide580_0| spec581_0)
(call-with-values
(lambda ()
(let ((app_0 (car bodys_0)))
(parse-and-expand-provides!
spec581_0
app_0
requires-and-provides90_0
self94_0
phase_0
(if (expand-context/outer? 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)))
(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))))
(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?"
ctx95_0)))))
(case-lambda
((track-stxes_0 specs_0)
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner
ctx95_0)))
(loop_0 (cdr bodys_0) phase_0)
(let ((new-s_0
(syntax-track-origin*
track-stxes_0
(let ((temp590_0
(car bodys_0)))
(let ((temp591_0
(list*
|#%provide580_0|
specs_0)))
(let ((temp590_1
temp590_0))
(rebuild.1
#t
temp590_1
temp591_0)))))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx95_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-prim
new-s_0)
(void)))
(cons
new-s_0
(loop_0
(cdr bodys_0)
phase_0))))))
(args
(raise-binding-result-arity-error
2
args)))))
(args
(raise-binding-result-arity-error
3
args)))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx95_0)))))
(if obs_0
(call-expand-observe obs_0 'next)
(void)))
(let ((app_0 (car bodys_0)))
(cons
app_0
(loop_0
(cdr bodys_0)
phase_0)))))))))))))))
(loop_0 expression-expanded-bodys102_0 phase93_0))
(if log-performance? (end-performance-region) (void))))))))
(define declare-module-for-expansion.1
(|#%name|
declare-module-for-expansion
(lambda (ctx111_0
enclosing109_0
fill113_0
module-name-id104_0
modules-being-compiled112_0
namespace107_0
rebuild-s105_0
requires-and-provides106_0
root-ctx110_0
self108_0
fully-expanded-bodys-except-post-submodules124_0)
(begin
(call-with-values
(lambda ()
(extract-requires-and-provides
requires-and-provides106_0
self108_0
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_1
(root-expand-context-encode-for-module
root-ctx110_0
self108_0
self108_0)))
(let ((app_2
(parsed-only
fully-expanded-bodys-except-post-submodules124_0)))
(parsed-module25.1
rebuild-s105_0
#f
module-name-id104_0
self108_0
requires_0
provides_0
app_0
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
(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_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))))))))
(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)
(let ((s_1
(syntax-property$1
s_0
'module-body-context
(begin-unsafe
(root-expand-context/inner-all-scopes-stx
(root-expand-context/outer-inner root-ctx_0))))))
(let ((s_2
(syntax-property$1
s_1
'module-body-inside-context
(apply-post-expansion
(begin-unsafe
(root-expand-context/outer-post-expansion root-ctx_0))
empty-syntax))))
s_2))))
(define expand-post-submodules.1
(|#%name|
expand-post-submodules
(lambda (all-scopes-s131_0
compiled-submodules134_0
ctx136_0
declare-enclosing126_0
declared-submodule-names133_0
enclosing-is-cross-phase-persistent?130_0
modules-being-compiled135_0
mpis-to-reset132_0
phase127_0
requires-and-provides129_0
self128_0
fully-expanded-bodys-except-post-submodules148_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (bodys_0 phase_0)
(begin
(if (null? bodys_0)
null
(let ((body_0 (car bodys_0)))
(let ((rest-bodys_0 (cdr bodys_0)))
(if (semi-parsed-begin-for-syntax? body_0)
(let ((body-s_0
(semi-parsed-begin-for-syntax-s body_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
'enter-begin-for-syntax)
(void)))
(call-with-values
(lambda ()
(let ((s_0 (syntax-disarm$1 body-s_0)))
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 s_0)
(syntax-e$1 s_0)
s_0)))
(if (pair? s_1)
(let ((begin-for-syntax605_0
(let ((s_2 (car s_1))) s_2)))
(let ((_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0
(to-syntax-list.1
s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
s_0)
flat-s_0))))))
(let ((begin-for-syntax605_1
begin-for-syntax605_0))
(values
begin-for-syntax605_1
_0))))
(raise-syntax-error$1
#f
"bad syntax"
s_0))))
(case-lambda
((begin-for-syntax603_0 _0)
(values #t begin-for-syntax603_0 _0))
(args
(raise-binding-result-arity-error
2
args))))))
(case-lambda
((ok?_0 begin-for-syntax603_0 _0)
(let ((rebuild-body-s_0
(keep-as-needed.1
#f
#f
#f
ctx136_0
body-s_0)))
(let ((nested-bodys_0
(loop_0
(semi-parsed-begin-for-syntax-body
body_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))))))))
(args
(raise-binding-result-arity-error 3 args))))))
(if (let ((or-part_0 (parsed? body_0)))
(if or-part_0
or-part_0
(expanded+parsed? body_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 'next)
(void)))
(cons body_0 (loop_0 rest-bodys_0 phase_0)))
(let ((disarmed-body_0 (syntax-disarm$1 body_0)))
(let ((tmp_0
(core-form-sym disarmed-body_0 phase_0)))
(if (eq? tmp_0 'module*)
(begin
(force declare-enclosing126_0)
(let ((ready-body_0
(remove-use-site-scopes
body_0
ctx136_0)))
(call-with-values
(lambda ()
(if (let ((s_0
(if (syntax?$1
disarmed-body_0)
(syntax-e$1 disarmed-body_0)
disarmed-body_0)))
(if (pair? s_0)
(if (let ((s_1 (car s_0))) #t)
(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)
(if (let ((s_3
(car s_2)))
#t)
(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)
(if (let ((s_5
(car
s_4)))
(let ((s_6
(if (syntax?$1
s_5)
(syntax-e$1
s_5)
s_5)))
(eq?
#f
s_6)))
(let ((s_5
(cdr
s_4)))
#t)
#f)
#f)))
#f)
#f)))
#f)
#f))
(call-with-values
(lambda ()
(let ((s_0
(if (syntax?$1
disarmed-body_0)
(syntax-e$1
disarmed-body_0)
disarmed-body_0)))
(let ((module*614_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)))
(let ((name617_0
(let ((s_3
(car s_2)))
s_3)))
(let ((_0
(let ((s_3
(cdr
s_2)))
(let ((s_4
(if (syntax?$1
s_3)
(syntax-e$1
s_3)
s_3)))
(call-with-values
(lambda ()
(let ((s_5
(car
s_4)))
(let ((s_6
(if (syntax?$1
s_5)
(syntax-e$1
s_5)
s_5)))
(values))))
(case-lambda
(()
(let ((_0
(let ((s_5
(cdr
s_4)))
s_5)))
(let ()
(values
_0))))
(args
(raise-binding-result-arity-error
0
args))))))))
(let ((name617_1
name617_0))
(values
name617_1
_0)))))))
(case-lambda
((name615_0 _0)
(let ((module*614_1
module*614_0))
(values
module*614_1
name615_0
_0)))
(args
(raise-binding-result-arity-error
2
args)))))))
(case-lambda
((module*611_0 name612_0 _0)
(values
#t
module*611_0
name612_0
_0))
(args
(raise-binding-result-arity-error
3
args))))
(values #f #f #f #f)))
(case-lambda
((ok?_0 module*611_0 name612_0 _0)
(let ((submod_0
(if ok?_0
(let ((neg-phase_0
(phase- 0 phase_0)))
(let ((shifted-s_0
(syntax-shift-phase-level$1
ready-body_0
neg-phase_0)))
(let ((submod_0
(expand-submodule.1
compiled-submodules134_0
declared-submodule-names133_0
enclosing-is-cross-phase-persistent?130_0
requires-and-provides129_0
#t
neg-phase_0
modules-being-compiled135_0
mpis-to-reset132_0
shifted-s_0
self128_0
ctx136_0)))
(if (parsed? submod_0)
submod_0
(if (expanded+parsed?
submod_0)
(if (expanded+parsed?
submod_0)
(let ((s631_0
(syntax-shift-phase-level$1
(expanded+parsed-s
submod_0)
phase_0)))
(expanded+parsed1.1
s631_0
(expanded+parsed-parsed
submod_0)))
(raise-argument-error
'struct-copy
"expanded+parsed?"
submod_0))
(syntax-shift-phase-level$1
submod_0
phase_0))))))
(expand-submodule.1
compiled-submodules134_0
declared-submodule-names133_0
#f
#f
#t
#f
modules-being-compiled135_0
mpis-to-reset132_0
ready-body_0
self128_0
ctx136_0))))
(cons
submod_0
(loop_0 rest-bodys_0 phase_0))))
(args
(raise-binding-result-arity-error
4
args))))))
(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 'next)
(void)))
(cons
body_0
(loop_0 rest-bodys_0 phase_0))))))))))))))))
(loop_0
fully-expanded-bodys-except-post-submodules148_0
phase127_0))))))
(define stop-at-module*?
(lambda (ctx_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)))
(syntax-shift-phase-level$1
(datum->syntax$1 core-stx 'module*)
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))))
(define check-ids-unbound.1
(|#%name|
check-ids-unbound
(lambda (in150_0 ids152_0 phase153_0 requires+provides154_0)
(begin
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((id_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(check-not-defined.1
#f
#f
#f
in150_0
#f
#f
'module
requires+provides154_0
id_0
phase153_0)
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 ids152_0)))
(void))))))
(define eval-nested-bodys
(lambda (bodys_0 phase_0 m-ns_0 self_0 ctx_0)
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((body_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(begin
(let ((p_0
(if (expanded+parsed? body_0)
(expanded+parsed-parsed body_0)
body_0)))
(if (parsed-define-values? p_0)
(let ((ids_0 (parsed-define-values-ids p_0)))
(let ((vals_0
(eval-for-bindings
'define-values
ids_0
(parsed-define-values-rhs p_0)
phase_0
m-ns_0
ctx_0)))
(begin
(let ((lst_1
(parsed-define-values-syms p_0)))
(begin
(letrec*
((for-loop_1
(|#%name|
for-loop
(lambda (lst_2 lst_3 lst_4)
(begin
(if (if (pair? lst_2)
(if (pair? lst_3)
(pair? lst_4)
#f)
#f)
(let ((id_0
(unsafe-car lst_2)))
(let ((rest_1
(unsafe-cdr lst_2)))
(let ((sym_0
(unsafe-car lst_3)))
(let ((rest_2
(unsafe-cdr
lst_3)))
(let ((val_0
(unsafe-car
lst_4)))
(let ((rest_3
(unsafe-cdr
lst_4)))
(begin
(namespace-set-variable!
m-ns_0
phase_0
sym_0
val_0)
(for-loop_1
rest_1
rest_2
rest_3))))))))
(values)))))))
(for-loop_1 ids_0 lst_1 vals_0))))
(void))))
(if (let ((or-part_0
(parsed-define-syntaxes? p_0)))
(if or-part_0
or-part_0
(semi-parsed-begin-for-syntax? p_0)))
(void)
(if (let ((or-part_0 (|parsed-#%declare?| p_0)))
(if or-part_0 or-part_0 (syntax?$1 p_0)))
(void)
(with-continuation-mark*
push-authentic
parameterization-key
(extend-parameterization
(continuation-mark-set-first
#f
parameterization-key)
1/current-namespace
m-ns_0)
(with-continuation-mark*
authentic
current-expand-context
ctx_0
(eval-single-top
(compile-single
p_0
(make-compile-context.1
#f
unsafe-undefined
#f
m-ns_0
phase_0
unsafe-undefined))
m-ns_0)))))))
(for-loop_0 rest_0))))
(values)))))))
(for-loop_0 bodys_0)))
(void))))
(define expand-submodule.1
(|#%name|
expand-submodule
(lambda (compiled-submodules162_0
declared-submodule-names161_0
enclosing-is-cross-phase-persistent?159_0
enclosing-requires+provides158_0
is-star?156_0
keep-enclosing-scope-at-phase157_0
modules-being-compiled163_0
mpis-to-reset160_0
s172_0
self173_0
ctx174_0)
(begin
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx174_0)))))
(if obs_0
(begin
(call-expand-observe obs_0 'enter-prim s172_0)
(call-expand-observe
obs_0
(if is-star?156_0 'prim-submodule* 'prim-submodule)
#f))
(void)))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_0 (if (syntax?$1 s172_0) (syntax-e$1 s172_0) s172_0)))
(if (pair? s_0)
(let ((module650_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 ((name653_0 (let ((s_3 (car s_2))) s_3)))
(let ((_0 (let ((s_3 (cdr s_2))) s_3)))
(let ((name653_1 name653_0))
(values name653_1 _0))))
(raise-syntax-error$1 #f "bad syntax" s172_0)))))
(case-lambda
((name651_0 _0)
(let ((module650_1 module650_0))
(values module650_1 name651_0 _0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" s172_0))))
(case-lambda
((module647_0 name648_0 _0) (values #t module647_0 name648_0 _0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 module647_0 name648_0 _0)
(let ((name_0 (syntax-e$1 name648_0)))
(begin
(if (hash-ref declared-submodule-names161_0 name_0 #f)
(raise-syntax-error$1
#f
"submodule already declared with the same name"
s172_0
name_0)
(void))
(begin
(hash-set!
declared-submodule-names161_0
name_0
(syntax-e$1 module647_0))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx174_0)))))
(if obs_0
(call-expand-observe obs_0 'enter-prim s172_0)
(void)))
(let ((submod_0
(let ((temp656_0
(if (expand-context/outer? ctx174_0)
(let ((the-struct_0
(root-expand-context/outer-inner
ctx174_0)))
(let ((inner666_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)
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))))
(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?"
ctx174_0))))
(expand-module.1
#t
enclosing-is-cross-phase-persistent?159_0
enclosing-requires+provides158_0
keep-enclosing-scope-at-phase157_0
modules-being-compiled163_0
mpis-to-reset160_0
s172_0
temp656_0
self173_0))))
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner ctx174_0)))))
(if obs_0
(call-expand-observe
obs_0
'exit-prim
(extract-syntax submod_0))
(void)))
(let ((ns_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx174_0)))))
(let ((module-name_0
(1/module-path-index-resolve self173_0)))
(let ((root-module-name_0
(resolved-module-path-root-name
module-name_0)))
(let ((compiled-submodule_0
(let ((temp668_0
(if (expanded+parsed? submod_0)
(expanded+parsed-parsed submod_0)
submod_0)))
(let ((temp669_0
(let ((temp677_0
(1/resolved-module-path-name
module-name_0)))
(make-compile-context.1
temp677_0
unsafe-undefined
self173_0
ns_0
unsafe-undefined
unsafe-undefined))))
(let ((temp671_0
(begin-unsafe
(expand-context/inner-for-serializable?
(root-expand-context/outer-inner
ctx174_0)))))
(let ((temp672_0
(begin-unsafe
(expand-context/inner-to-correlated-linklet?
(root-expand-context/outer-inner
ctx174_0)))))
(let ((temp671_1 temp671_0)
(temp669_1 temp669_0)
(temp668_1 temp668_0))
(compile-module.1
#t
modules-being-compiled163_0
#f
temp671_1
temp672_0
temp668_1
temp669_1))))))))
(begin
(hash-set!
compiled-submodules162_0
name_0
(cons is-star?156_0 compiled-submodule_0))
(with-continuation-mark*
push-authentic
parameterization-key
(let ((app_0
(continuation-mark-set-first
#f
parameterization-key)))
(extend-parameterization
app_0
1/current-namespace
ns_0
1/current-module-declare-name
(1/make-resolved-module-path
root-module-name_0)))
(eval-module.1
unsafe-undefined
#f
#f
compiled-submodule_0))
(if (not is-star?156_0)
submod_0
(if (expanded+parsed? submod_0)
(if (expanded+parsed? submod_0)
(let ((the-struct_0
(expanded+parsed-parsed
submod_0)))
(let ((parsed680_0
(if (parsed-module?
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)))
(raise-argument-error
'struct-copy
"expanded+parsed?"
submod_0))
(if (parsed-module? 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?"
submod_0))))))))))))))))
(args (raise-binding-result-arity-error 4 args)))))))))
(define expand-non-module*-submodules.1
(|#%name|
expand-non-module*-submodules
(lambda (compiled-submodules178_0
declared-submodule-names177_0
modules-being-compiled179_0
mpis-to-reset176_0
bodys184_0
phase185_0
self186_0
ctx187_0)
(begin
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((body_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(begin
(let ((obs_0
(begin-unsafe
(expand-context/inner-observer
(root-expand-context/outer-inner
ctx187_0)))))
(if obs_0
(call-expand-observe obs_0 'next)
(void)))
(let ((tmp_0
(core-form-sym
(syntax-disarm$1 body_0)
phase185_0)))
(if (eq? tmp_0 'module)
(expand-submodule.1
compiled-submodules178_0
declared-submodule-names177_0
#f
#f
#f
#f
modules-being-compiled179_0
mpis-to-reset176_0
body_0
self186_0
ctx187_0)
body_0)))
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null bodys184_0))))))))
(define make-parse-lifted-require.1
(|#%name|
make-parse-lifted-require
(lambda (declared-submodule-names189_0
m-ns191_0
self192_0
requires+provides193_0)
(begin
(lambda (s_0 phase_0)
(call-with-values
(lambda ()
(let ((s_1 (syntax-disarm$1 s_0)))
(call-with-values
(lambda ()
(let ((s_2 (if (syntax?$1 s_1) (syntax-e$1 s_1) s_1)))
(if (pair? s_2)
(let ((|#%require693_0| (let ((s_3 (car s_2))) s_3)))
(let ((req694_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 ((req695_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"
s_1)))))
(case-lambda
(()
(let ((req695_1 req695_0))
(values req695_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
s_1))))))
(let ((|#%require693_1| |#%require693_0|))
(values |#%require693_1| req694_0))))
(raise-syntax-error$1 #f "bad syntax" s_1))))
(case-lambda
((|#%require691_0| req692_0)
(values #t |#%require691_0| req692_0))
(args (raise-binding-result-arity-error 2 args))))))
(case-lambda
((ok?_0 |#%require691_0| req692_0)
(let ((temp696_0 (list req692_0)))
(parse-and-perform-requires!.1
#f
#f
declared-submodule-names189_0
#f
phase_0
#f
self192_0
#f
#t
'require
temp696_0
s_0
m-ns191_0
phase_0
requires+provides193_0)))
(args (raise-binding-result-arity-error 3 args)))))))))
(define defn-extract-syntax
(lambda (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
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((lifted-defn_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(defn-extract-syntax lifted-defn_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null lifted-defns_0))))))
(define as-expand-time-top-level-bindings
(lambda (ids_0 s_0 ctx_0)
(let ((top-level-bind-scope_0
(begin-unsafe
(root-expand-context/inner-top-level-bind-scope
(root-expand-context/outer-inner ctx_0)))))
(let ((tl-ids_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(remove-use-site-scopes
id_0
ctx_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))))))
(begin
(let ((temp2_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(check-no-duplicate-ids.1
unsafe-undefined
tl-ids_0
temp2_0
s_0
unsafe-undefined))
(let ((tmp-bind-ids_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 lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope
id_0
top-level-bind-scope_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0 fold-var_1 rest_0))))
fold-var_0))))))
(for-loop_0 null tl-ids_0))))))
(values
tl-ids_0
(select-defined-syms-and-bind!/ctx tmp-bind-ids_0 ctx_0))))))))
(define effect_2375
(begin
(void
(add-core-form!*
'define-values
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-define-values disarmed-s_0)
(void)))
(begin
(if (eq?
(begin-unsafe (expand-context/outer-context ctx_0))
'top-level)
(void)
(raise-syntax-error$1
#f
"not allowed in an expression position"
s_0))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0)))
(if (pair? s_1)
(let ((define-values4_0 (let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(let ((id7_0
(let ((s_4 (car s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1 s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
s_0)
(let ((id_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (id_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((s_6
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((id_1
(let ((id_1
(let ((id10_0
(if (let ((or-part_0
(if (syntax?$1
s_6)
(symbol?
(syntax-e$1
s_6))
#f)))
(if or-part_0
or-part_0
(symbol?
s_6)))
s_6
(raise-syntax-error$1
#f
"not an identifier"
s_0
s_6))))
(cons
id10_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 ((rhs8_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(let ((rhs9_0
(let ((s_6 (car s_5)))
s_6)))
(call-with-values
(lambda ()
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (null? s_7)
(values)
(raise-syntax-error$1
#f
"bad syntax"
s_0)))))
(case-lambda
(()
(let ((rhs9_1 rhs9_0))
(values rhs9_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
s_0))))))
(let ((id7_1 id7_0))
(values id7_1 rhs8_0))))
(raise-syntax-error$1
#f
"bad syntax"
s_0)))))
(case-lambda
((id5_0 rhs6_0)
(let ((define-values4_1 define-values4_0))
(values define-values4_1 id5_0 rhs6_0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" s_0))))
(case-lambda
((define-values1_0 id2_0 rhs3_0)
(values #t define-values1_0 id2_0 rhs3_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 define-values1_0 id2_0 rhs3_0)
(call-with-values
(lambda ()
(as-expand-time-top-level-bindings id2_0 s_0 ctx_0))
(case-lambda
((ids_0 syms_0)
(let ((exp-rhs_0
(let ((temp12_0
(as-named-context
(as-expression-context ctx_0)
ids_0)))
(expand.1 #f #f rhs3_0 temp12_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-define-values19.1 s_0 ids_0 syms_0 exp-rhs_0)
(let ((temp14_0
(list define-values1_0 ids_0 exp-rhs_0)))
(rebuild.1 #t s_0 temp14_0)))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 4 args))))))))))
(void)))
(define effect_2226
(begin
(void
(add-core-form!*
'define-syntaxes
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-define-syntaxes disarmed-s_0)
(void)))
(begin
(if (eq?
(begin-unsafe (expand-context/outer-context ctx_0))
'top-level)
(void)
(raise-syntax-error$1 #f "not in a definition context" s_0))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((define-syntaxes18_0
(let ((s_2 (car s_1))) s_2)))
(call-with-values
(lambda ()
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(if (pair? s_3)
(let ((id21_0
(let ((s_4 (car s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(let ((flat-s_0
(to-syntax-list.1 s_5)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
(let ((id_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (id_0
lst_0)
(begin
(if (pair?
lst_0)
(let ((s_6
(unsafe-car
lst_0)))
(let ((rest_0
(unsafe-cdr
lst_0)))
(let ((id_1
(let ((id_1
(let ((id24_0
(if (let ((or-part_0
(if (syntax?$1
s_6)
(symbol?
(syntax-e$1
s_6))
#f)))
(if or-part_0
or-part_0
(symbol?
s_6)))
s_6
(raise-syntax-error$1
#f
"not an identifier"
disarmed-s_0
s_6))))
(cons
id24_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 ((rhs22_0
(let ((s_4 (cdr s_3)))
(let ((s_5
(if (syntax?$1 s_4)
(syntax-e$1 s_4)
s_4)))
(if (pair? s_5)
(let ((rhs23_0
(let ((s_6 (car s_5)))
s_6)))
(call-with-values
(lambda ()
(let ((s_6 (cdr s_5)))
(let ((s_7
(if (syntax?$1
s_6)
(syntax-e$1
s_6)
s_6)))
(if (null? s_7)
(values)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
(()
(let ((rhs23_1 rhs23_0))
(values rhs23_1)))
(args
(raise-binding-result-arity-error
0
args)))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0))))))
(let ((id21_1 id21_0))
(values id21_1 rhs22_0))))
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)))))
(case-lambda
((id19_0 rhs20_0)
(let ((define-syntaxes18_1 define-syntaxes18_0))
(values define-syntaxes18_1 id19_0 rhs20_0)))
(args (raise-binding-result-arity-error 2 args)))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((define-syntaxes15_0 id16_0 rhs17_0)
(values #t define-syntaxes15_0 id16_0 rhs17_0))
(args (raise-binding-result-arity-error 3 args)))))
(case-lambda
((ok?_0 define-syntaxes15_0 id16_0 rhs17_0)
(call-with-values
(lambda ()
(as-expand-time-top-level-bindings id16_0 s_0 ctx_0))
(case-lambda
((ids_0 syms_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 'prepare-env)
(void)))
(let ((exp-rhs_0
(let ((temp26_0 (as-named-context ctx_0 ids_0)))
(expand-transformer.1
#f
#f
'expression
#t
#f
unsafe-undefined
rhs17_0
temp26_0))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-define-syntaxes20.1
s_0
ids_0
syms_0
exp-rhs_0)
(let ((temp28_0
(list define-syntaxes15_0 ids_0 exp-rhs_0)))
(rebuild.1 #t s_0 temp28_0))))))
(args (raise-binding-result-arity-error 2 args)))))
(args (raise-binding-result-arity-error 4 args))))))))))
(void)))
(define effect_2511
(begin
(void
(add-core-form!*
'begin-for-syntax
(lambda (s_0 ctx_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 'prim-begin-for-syntax #f)
(void)))
(begin
(if (eq?
(begin-unsafe (expand-context/outer-context ctx_0))
'top-level)
(void)
(raise-syntax-error$1 #f "not in a definition context" s_0))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1 (if (syntax?$1 s_0) (syntax-e$1 s_0) s_0)))
(if (pair? s_1)
(let ((begin-for-syntax31_0 (let ((s_2 (car s_1))) s_2)))
(let ((form32_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
s_0)
flat-s_0))))))
(let ((begin-for-syntax31_1 begin-for-syntax31_0))
(values begin-for-syntax31_1 form32_0))))
(raise-syntax-error$1 #f "bad syntax" s_0))))
(case-lambda
((begin-for-syntax29_0 form30_0)
(values #t begin-for-syntax29_0 form30_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 begin-for-syntax29_0 form30_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 'prepare-env) (void)))
(let ((trans-ctx_0
(context->transformer-context.1 #t ctx_0 'top-level)))
(let ((lift-ctx_0
(let ((temp36_0 (make-top-level-lift trans-ctx_0)))
(make-lift-context.1 #f temp36_0))))
(let ((capture-ctx_0
(if (expand-context/outer? 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)))
(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))))
(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?"
trans-ctx_0))))
(let ((all-exp-forms_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (forms_0)
(begin
(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
'enter-list
form30_0)
(void)))
(let ((exp-forms_0
(letrec*
((loop_1
(|#%name|
loop
(lambda (forms_1 accum_0)
(begin
(if (null? forms_1)
(let ((forms_2
(reverse$1
accum_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
'exit-list
forms_2)
(void)))
forms_2))
(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 ((exp-form_0
(let ((temp40_0
(car
forms_1)))
(expand.1
#f
#f
temp40_0
capture-ctx_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
(box-clear!
(lift-context-lifts
lift-ctx_0)))))
(if (null? lifts_0)
exp-forms_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
'module-lift-loop
lifts_0)
(void)))
(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
(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?
(root-expand-context/outer-inner ctx_0)))
(parsed-begin-for-syntax21.1 s_0 all-exp-forms_0)
(let ((temp46_0
(cons begin-for-syntax29_0 all-exp-forms_0)))
(rebuild.1 #t s_0 temp46_0)))))))))
(args (raise-binding-result-arity-error 3 args)))))))))
(void)))
(define effect_2818
(begin
(void
(add-core-form!*
'|#%require|
(lambda (s_0 ctx_0)
(let ((disarmed-s_0 (syntax-disarm$1 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 'prim-require disarmed-s_0)
(void)))
(begin
(if (eq?
(begin-unsafe (expand-context/outer-context ctx_0))
'top-level)
(void)
(raise-syntax-error$1
#f
"allowed only in a module or the top level"
s_0))
(call-with-values
(lambda ()
(call-with-values
(lambda ()
(let ((s_1
(if (syntax?$1 disarmed-s_0)
(syntax-e$1 disarmed-s_0)
disarmed-s_0)))
(if (pair? s_1)
(let ((|#%require49_0| (let ((s_2 (car s_1))) s_2)))
(let ((req50_0
(let ((s_2 (cdr s_1)))
(let ((s_3
(if (syntax?$1 s_2)
(syntax-e$1 s_2)
s_2)))
(let ((flat-s_0 (to-syntax-list.1 s_3)))
(if (not flat-s_0)
(raise-syntax-error$1
#f
"bad syntax"
disarmed-s_0)
flat-s_0))))))
(let ((|#%require49_1| |#%require49_0|))
(values |#%require49_1| req50_0))))
(raise-syntax-error$1 #f "bad syntax" disarmed-s_0))))
(case-lambda
((|#%require47_0| req48_0)
(values #t |#%require47_0| req48_0))
(args (raise-binding-result-arity-error 2 args)))))
(case-lambda
((ok?_0 |#%require47_0| req48_0)
(let ((sc_0 (new-scope 'macro)))
(let ((ns_0
(begin-unsafe
(expand-context/inner-namespace
(root-expand-context/outer-inner ctx_0)))))
(begin
(let ((temp51_0
(reverse$1
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (fold-var_0 lst_0)
(begin
(if (pair? lst_0)
(let ((req_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(let ((fold-var_1
(let ((fold-var_1
(cons
(add-scope
req_0
sc_0)
fold-var_0)))
(values fold-var_1))))
(for-loop_0
fold-var_1
rest_0))))
fold-var_0))))))
(for-loop_0 null req48_0))))))
(let ((temp53_0
(namespace-self-mpi/no-top-level ns_0)))
(let ((temp56_0
(begin-unsafe
(expand-context/inner-phase
(root-expand-context/outer-inner ctx_0)))))
(let ((temp57_0 (make-requires+provides.1 #f #f)))
(let ((temp56_1 temp56_0)
(temp53_1 temp53_0)
(temp51_1 temp51_0))
(parse-and-perform-requires!.1
#f
#f
hash2610
#t
unsafe-undefined
#f
temp53_1
#f
#f
'require
temp51_1
s_0
ns_0
temp56_1
temp57_0))))))
(if (begin-unsafe
(expand-context/inner-to-parsed?
(root-expand-context/outer-inner ctx_0)))
(parsed-require23.1 s_0)
s_0)))))
(args (raise-binding-result-arity-error 3 args))))))))))
(void)))
(define effect_2881
(begin
(void
(add-core-form!*
'|#%provide|
(lambda (s_0 ctx_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 'prim-provide #f) (void)))
(raise-syntax-error$1
#f
"not allowed outside of a module body"
s_0)))))
(void)))
(define namespace-init!
(lambda ()
(let ((ns_0 (make-namespace)))
(void
(begin
(declare-core-module! ns_0)
(declare-hash-based-module!.1
ns_0
#f
null
#f
#f
'|#%read|
read-primitives)
(declare-hash-based-module!.1
ns_0
#f
null
#f
#f
'|#%main|
main-primitives)
(declare-hash-based-module!.1
ns_0
#f
null
#f
#f
'|#%utils|
utils-primitives)
(let ((temp13_0 '(dynamic-place)))
(declare-hash-based-module!.1
ns_0
#f
temp13_0
#f
#f
'|#%place-struct|
place-struct-primitives))
(declare-hash-based-module!.1
ns_0
#f
null
#f
#f
'|#%boot|
boot-primitives)
(let ((linklet-primitives_0
(hash-remove
(hash-remove linklet-primitives 'variable-reference?)
'variable-reference-constant?)))
(begin
(declare-hash-based-module!.1
ns_0
#t
null
#t
#t
'|#%linklet-primitive|
linklet-primitives_0)
(declare-hash-based-module!.1
ns_0
#f
null
#t
#f
'|#%linklet-expander|
linklet-expander-primitives)
(let ((temp28_0
(list '|#%linklet-primitive| '|#%linklet-expander|)))
(declare-reexporting-module!.1 ns_0 #t '|#%linklet| temp28_0))))
(declare-hash-based-module!.1
ns_0
#f
null
#t
#f
'|#%expobs|
expobs-primitives)
(let ((temp35_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((name_0
(hash-iterate-key main-primitives i_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values name_0 #t))
(case-lambda
((key_0 val_0)
(hash-set table_0 key_0 val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next main-primitives i_0))))
table_0))))))
(for-loop_0
hash2725
(hash-iterate-first main-primitives))))))
(let ((temp36_0
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (table_0 i_0)
(begin
(if i_0
(let ((name_0
(hash-iterate-key read-primitives i_0)))
(let ((table_1
(let ((table_1
(call-with-values
(lambda () (values name_0 #t))
(case-lambda
((key_0 val_0)
(hash-set
table_0
key_0
val_0))
(args
(raise-binding-result-arity-error
2
args))))))
(values table_1))))
(for-loop_0
table_1
(hash-iterate-next read-primitives i_0))))
table_0))))))
(for-loop_0
hash2725
(hash-iterate-first read-primitives))))))
(let ((temp35_1 temp35_0))
(declare-kernel-module!.1 temp35_1 temp36_0 ns_0))))
(begin
(begin
(letrec*
((for-loop_0
(|#%name|
for-loop
(lambda (lst_0)
(begin
(if (pair? lst_0)
(let ((name_0 (unsafe-car lst_0)))
(let ((rest_0 (unsafe-cdr lst_0)))
(call-with-values
(lambda ()
(if (eq? name_0 '|#%kernel|)
(values)
(begin
(let ((or-part_0 (eq? name_0 '|#%foreign|)))
(let ((temp39_0
(if or-part_0
or-part_0
(let ((or-part_1
(eq? name_0 '|#%futures|)))
(if or-part_1
or-part_1
(eq? name_0 '|#%unsafe|))))))
(copy-runtime-module!.1
hash2610
hash2610
ns_0
#t
temp39_0
unsafe-undefined
unsafe-undefined
name_0)))
(values))))
(case-lambda
(() (for-loop_0 rest_0))
(args
(raise-binding-result-arity-error 0 args))))))
(values)))))))
(for-loop_0 runtime-instances)))
(void))
(let ((temp41_0
(list*
'|#%place-struct|
'|#%utils|
'|#%boot|
'|#%expobs|
'|#%linklet|
runtime-instances)))
(declare-reexporting-module!.1 ns_0 #f '|#%builtin| temp41_0))
(1/current-namespace ns_0)
(1/dynamic-require ''|#%kernel| 0))))))
(define effect_2376
(begin
(|#%call-with-values| (lambda () (namespace-init!)) print-values)
(void)))
(define datum->kernel-syntax (lambda (s_0) (1/datum->syntax core-stx s_0)))
(define expander-place-init!
(lambda ()
(begin
(syntax-place-init!)
(scope-place-init!)
(cache-place-init!)
(core-place-init!)
(module-path-place-init!)
(module-cache-place-init!)
(shadow-directory-place-init!)
(collection-place-init!)
(performance-place-init!)
(namespace-init!))))
Reference in New Issue View Git Blame Copy Permalink